{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeApplications #-}
{-# OPTIONS_GHC -fno-warn-ambiguous-fields #-}

module Simplex.Chat.Library.Internal where

import Control.Applicative ((<|>))
import Control.Concurrent.STM (retry)
import Control.Logger.Simple
import Control.Monad
import Control.Monad.Except
import Control.Monad.IO.Unlift
import Control.Monad.Reader
import Crypto.Random (ChaChaDRG)
import Data.Bifunctor (first)
import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as B
import Data.Char (isDigit)
import Data.Containers.ListUtils (nubOrd)
import Data.Either (partitionEithers, rights)
import Data.Fixed (div')
import Data.Foldable (foldr')
import Data.Functor (($>))
import Data.Functor.Identity
import Data.Int (Int64)
import Data.List (find, foldl', mapAccumL, partition)
import Data.List.NonEmpty (NonEmpty (..), (<|))
import qualified Data.List.NonEmpty as L
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as M
import Data.Maybe (catMaybes, fromMaybe, isJust, isNothing, mapMaybe)
import qualified Data.Set as S
import Data.Text (Text)
import qualified Data.Text as T
import Data.Text.Encoding (encodeUtf8)
import Data.Time (addUTCTime)
import Data.Time.Calendar (fromGregorian)
import Data.Time.Clock (UTCTime (..), diffUTCTime, getCurrentTime, nominalDiffTimeToSeconds, secondsToDiffTime)
import Simplex.Chat.Call
import Simplex.Chat.Controller
import Simplex.Chat.Files
import Simplex.Chat.Markdown
import Simplex.Chat.Messages
import Simplex.Chat.Messages.Batch (MsgBatch (..), batchMessages)
import Simplex.Chat.Messages.CIContent
import Simplex.Chat.Messages.CIContent.Events
import Simplex.Chat.Operators
import Simplex.Chat.ProfileGenerator (generateRandomProfile)
import Simplex.Chat.Protocol
import Simplex.Chat.Store
import Simplex.Chat.Store.ContactRequest
import Simplex.Chat.Store.Direct
import Simplex.Chat.Store.Files
import Simplex.Chat.Store.Groups
import Simplex.Chat.Store.Messages
import Simplex.Chat.Store.Profiles
import Simplex.Chat.Store.Shared
import Simplex.Chat.Types
import Simplex.Chat.Types.Preferences
import Simplex.Chat.Types.Shared
import Simplex.Chat.Util (encryptFile, shuffle)
import Simplex.FileTransfer.Description (FileDescriptionURI (..), ValidFileDescription)
import qualified Simplex.FileTransfer.Description as FD
import Simplex.FileTransfer.Protocol (FileParty (..), FilePartyI)
import Simplex.FileTransfer.Types (RcvFileId, SndFileId)
import Simplex.Messaging.Agent as Agent
import Simplex.Messaging.Agent.Client (getFastNetworkConfig, ipAddressProtected, withLockMap)
import Simplex.Messaging.Agent.Env.SQLite (AgentConfig (..), ServerCfg (..))
import Simplex.Messaging.Agent.Lock (withLock)
import Simplex.Messaging.Agent.Protocol
import qualified Simplex.Messaging.Agent.Protocol as AP (AgentErrorType (..))
import qualified Simplex.Messaging.Agent.Store.DB as DB
import Simplex.Messaging.Client (NetworkConfig (..), NetworkRequestMode)
import Simplex.Messaging.Crypto.File (CryptoFile (..), CryptoFileArgs (..))
import qualified Simplex.Messaging.Crypto.File as CF
import Simplex.Messaging.Crypto.Ratchet (PQEncryption (..), PQSupport (..), pattern IKPQOff, pattern PQEncOff, pattern PQEncOn, pattern PQSupportOff, pattern PQSupportOn)
import qualified Simplex.Messaging.Crypto.Ratchet as CR
import Simplex.Messaging.Encoding
import Simplex.Messaging.Encoding.String
import Simplex.Messaging.Protocol (MsgBody, MsgFlags (..), ProtoServerWithAuth (..), ProtocolServer, ProtocolTypeI (..), SProtocolType (..), SubscriptionMode (..), UserProtocol, XFTPServer)
import qualified Simplex.Messaging.Protocol as SMP
import qualified Simplex.Messaging.TMap as TM
import Simplex.Messaging.Util
import Simplex.Messaging.Version
import System.FilePath (takeFileName, (</>))
import System.IO (Handle, IOMode (..), SeekMode (..), hFlush)
import UnliftIO.Concurrent (forkFinally, mkWeakThreadId)
import UnliftIO.Directory
import UnliftIO.IO (hClose, hSeek, hTell, openFile)
import UnliftIO.STM

maxMsgReactions :: Int
maxMsgReactions = 3

maxRcvMentions :: Int
maxRcvMentions = 5

maxSndMentions :: Int
maxSndMentions = 3

withChatLock :: Text -> CM a -> CM a
withChatLock name action = asks chatLock >>= \l -> withLock l name action

withEntityLock :: Text -> ChatLockEntity -> CM a -> CM a
withEntityLock name entity action = do
  chatLock <- asks chatLock
  ls <- asks entityLocks
  atomically $ unlessM (isEmptyTMVar chatLock) retry
  withLockMap ls entity name action

withInvitationLock :: Text -> ByteString -> CM a -> CM a
withInvitationLock name = withEntityLock name . CLInvitation
{-# INLINE withInvitationLock #-}

withConnectionLock :: Text -> Int64 -> CM a -> CM a
withConnectionLock name = withEntityLock name . CLConnection
{-# INLINE withConnectionLock #-}

withContactLock :: Text -> ContactId -> CM a -> CM a
withContactLock name = withEntityLock name . CLContact
{-# INLINE withContactLock #-}

withGroupLock :: Text -> GroupId -> CM a -> CM a
withGroupLock name = withEntityLock name . CLGroup
{-# INLINE withGroupLock #-}

withUserContactLock :: Text -> Int64 -> CM a -> CM a
withUserContactLock name = withEntityLock name . CLUserContact
{-# INLINE withUserContactLock #-}

withContactRequestLock :: Text -> Int64 -> CM a -> CM a
withContactRequestLock name = withEntityLock name . CLContactRequest
{-# INLINE withContactRequestLock #-}

withFileLock :: Text -> Int64 -> CM a -> CM a
withFileLock name = withEntityLock name . CLFile
{-# INLINE withFileLock #-}

useServerCfgs :: forall p. UserProtocol p => SProtocolType p -> RandomAgentServers -> [(Text, ServerOperator)] -> [UserServer p] -> NonEmpty (ServerCfg p)
useServerCfgs p RandomAgentServers {smpServers, xftpServers} opDomains =
  fromMaybe (rndAgentServers p) . L.nonEmpty . agentServerCfgs p opDomains
  where
    rndAgentServers :: SProtocolType p -> NonEmpty (ServerCfg p)
    rndAgentServers = \case
      SPSMP -> smpServers
      SPXFTP -> xftpServers

contactCITimed :: Contact -> CM (Maybe CITimed)
contactCITimed ct = sndContactCITimed False ct Nothing

sndContactCITimed :: Bool -> Contact -> Maybe Int -> CM (Maybe CITimed)
sndContactCITimed live = sndCITimed_ live . contactTimedTTL

sndGroupCITimed :: Bool -> GroupInfo -> Maybe Int -> CM (Maybe CITimed)
sndGroupCITimed live = sndCITimed_ live . groupTimedTTL

sndCITimed_ :: Bool -> Maybe (Maybe Int) -> Maybe Int -> CM (Maybe CITimed)
sndCITimed_ live chatTTL itemTTL =
  forM (chatTTL >>= (itemTTL <|>)) $ \ttl ->
    CITimed ttl
      <$> if live
        then pure Nothing
        else Just . addUTCTime (realToFrac ttl) <$> liftIO getCurrentTime

callTimed :: Contact -> ACIContent -> CM (Maybe CITimed)
callTimed ct aciContent =
  case aciContentCallStatus aciContent of
    Just callStatus
      | callComplete callStatus -> do
          contactCITimed ct
    _ -> pure Nothing
  where
    aciContentCallStatus :: ACIContent -> Maybe CICallStatus
    aciContentCallStatus (ACIContent _ (CISndCall st _)) = Just st
    aciContentCallStatus (ACIContent _ (CIRcvCall st _)) = Just st
    aciContentCallStatus _ = Nothing

toggleNtf :: GroupMember -> Bool -> CM ()
toggleNtf m ntfOn =
  when (memberActive m) $
    forM_ (memberConnId m) $ \connId ->
      withAgent (\a -> toggleConnectionNtfs a connId ntfOn) `catchAllErrors` eToView

prepareGroupMsg :: DB.Connection -> User -> GroupInfo -> Maybe MsgScope -> MsgContent -> Map MemberName MsgMention -> Maybe ChatItemId -> Maybe CIForwardedFrom -> Maybe FileInvitation -> Maybe CITimed -> Bool -> ExceptT StoreError IO (ChatMsgEvent 'Json, Maybe (CIQuote 'CTGroup))
prepareGroupMsg db user g@GroupInfo {membership} msgScope mc mentions quotedItemId_ itemForwarded fInv_ timed_ live = case (quotedItemId_, itemForwarded) of
  (Nothing, Nothing) ->
    let mc' = MCSimple $ ExtMsgContent mc mentions fInv_ (ttl' <$> timed_) (justTrue live) msgScope
     in pure (XMsgNew mc', Nothing)
  (Nothing, Just _) ->
    let mc' = MCForward $ ExtMsgContent mc mentions fInv_ (ttl' <$> timed_) (justTrue live) msgScope
     in pure (XMsgNew mc', Nothing)
  (Just quotedItemId, Nothing) -> do
    CChatItem _ qci@ChatItem {meta = CIMeta {itemTs, itemSharedMsgId}, formattedText, mentions = quoteMentions, file} <-
      getGroupCIWithReactions db user g quotedItemId
    (origQmc, qd, sent, GroupMember {memberId}) <- quoteData qci membership
    let msgRef = MsgRef {msgId = itemSharedMsgId, sentAt = itemTs, sent, memberId = Just memberId}
        qmc = quoteContent mc origQmc file
        (qmc', ft', _) = updatedMentionNames qmc formattedText quoteMentions
        quotedItem = CIQuote {chatDir = qd, itemId = Just quotedItemId, sharedMsgId = itemSharedMsgId, sentAt = itemTs, content = qmc', formattedText = ft'}
        mc' = MCQuote QuotedMsg {msgRef, content = qmc'} (ExtMsgContent mc mentions fInv_ (ttl' <$> timed_) (justTrue live) msgScope)
    pure (XMsgNew mc', Just quotedItem)
  (Just _, Just _) -> throwError SEInvalidQuote
  where
    quoteData :: ChatItem c d -> GroupMember -> ExceptT StoreError IO (MsgContent, CIQDirection 'CTGroup, Bool, GroupMember)
    quoteData ChatItem {meta = CIMeta {itemDeleted = Just _}} _ = throwError SEInvalidQuote
    quoteData ChatItem {chatDir = CIGroupSnd, content = CISndMsgContent qmc} membership' = pure (qmc, CIQGroupSnd, True, membership')
    quoteData ChatItem {chatDir = CIGroupRcv m, content = CIRcvMsgContent qmc} _ = pure (qmc, CIQGroupRcv $ Just m, False, m)
    quoteData _ _ = throwError SEInvalidQuote

updatedMentionNames :: MsgContent -> Maybe MarkdownList -> Map MemberName CIMention -> (MsgContent, Maybe MarkdownList, Map MemberName CIMention)
updatedMentionNames mc ft_ mentions = case ft_ of
  Just ft
    | not (null ft) && not (null mentions) && not (all sameName $ M.assocs mentions) ->
        let (mentions', ft') = mapAccumL update M.empty ft
            text = T.concat $ map markdownText ft'
         in (mc {text} :: MsgContent, Just ft', mentions')
  _ -> (mc, ft_, mentions)
  where
    sameName (name, CIMention {memberRef}) = case memberRef of
      Just CIMentionMember {displayName} -> case T.stripPrefix displayName name of
        Just rest
          | T.null rest -> True
          | otherwise -> case T.uncons rest of
              Just ('_', suffix) -> T.all isDigit suffix
              _ -> False
        Nothing -> False
      Nothing -> True
    update mentions' ft@(FormattedText f _) = case f of
      Just (Mention name) -> case M.lookup name mentions of
        Just mm@CIMention {memberRef} ->
          let name' = uniqueMentionName 0 $ case memberRef of
                Just CIMentionMember {displayName} -> displayName
                Nothing -> name
           in (M.insert name' mm mentions', FormattedText (Just $ Mention name') ('@' `T.cons` viewName name'))
        Nothing -> (mentions', ft)
      _ -> (mentions', ft)
      where
        uniqueMentionName :: Int -> Text -> Text
        uniqueMentionName pfx name =
          let prefixed = if pfx == 0 then name else (name `T.snoc` '_') <> tshow pfx
           in if prefixed `M.member` mentions' then uniqueMentionName (pfx + 1) name else prefixed

getCIMentions :: DB.Connection -> User -> GroupInfo -> Maybe MarkdownList -> Map MemberName GroupMemberId -> ExceptT StoreError IO (Map MemberName CIMention)
getCIMentions db user GroupInfo {groupId} ft_ mentions = case ft_ of
  Just ft | not (null ft) && not (null mentions) -> do
    let msgMentions = S.fromList $ mentionedNames ft
        n = M.size mentions
    -- prevent "invisible" and repeated-with-different-name mentions (when the same member is mentioned via another name)
    unless (n <= maxSndMentions && all (`S.member` msgMentions) (M.keys mentions) && S.size (S.fromList $ M.elems mentions) == n) $
      throwError SEInvalidMention
    mapM (getMentionedGroupMember db user groupId) mentions
  _ -> pure M.empty

getRcvCIMentions :: DB.Connection -> User -> GroupInfo -> Maybe MarkdownList -> Map MemberName MsgMention -> IO (Map MemberName CIMention)
getRcvCIMentions db user GroupInfo {groupId} ft_ mentions = case ft_ of
  Just ft
    | not (null ft) && not (null mentions) ->
        let mentions' = uniqueMsgMentions maxRcvMentions mentions $ mentionedNames ft
         in mapM (getMentionedMemberByMemberId db user groupId) mentions'
  _ -> pure M.empty

-- prevent "invisible" and repeated-with-different-name mentions
uniqueMsgMentions :: Int -> Map MemberName MsgMention -> [ContactName] -> Map MemberName MsgMention
uniqueMsgMentions maxMentions mentions = go M.empty S.empty 0
  where
    go acc _ _ [] = acc
    go acc seen n (name : rest)
      | n >= maxMentions = acc
      | otherwise = case M.lookup name mentions of
          Just mm@MsgMention {memberId}
            | S.notMember memberId seen ->
                go (M.insert name mm acc) (S.insert memberId seen) (n + 1) rest
          _ -> go acc seen n rest

getMessageMentions :: DB.Connection -> User -> GroupId -> Text -> IO (Map MemberName GroupMemberId)
getMessageMentions db user gId msg = case parseMaybeMarkdownList msg of
  Just ft | not (null ft) -> M.fromList . catMaybes <$> mapM get (nubOrd $ mentionedNames ft)
  _ -> pure M.empty
  where
    get name =
      fmap (name,) . eitherToMaybe
        <$> runExceptT (getGroupMemberIdByName db user gId name)

msgContentTexts :: MsgContent -> (Text, Maybe MarkdownList)
msgContentTexts mc = let t = msgContentText mc in (t, parseMaybeMarkdownList t)

ciContentTexts :: CIContent d -> (Text, Maybe MarkdownList)
ciContentTexts content = let t = ciContentToText content in (t, parseMaybeMarkdownList t)

quoteContent :: forall d. MsgContent -> MsgContent -> Maybe (CIFile d) -> MsgContent
quoteContent mc qmc ciFile_
  | replaceContent = MCText qTextOrFile
  | otherwise = case qmc of
      MCImage _ image -> MCImage qTextOrFile image
      MCFile _ -> MCFile qTextOrFile
      -- consider same for voice messages
      -- MCVoice _ voice -> MCVoice qTextOrFile voice
      _ -> qmc
  where
    -- if the message we're quoting with is one of the "large" MsgContents
    -- we replace the quote's content with MCText
    replaceContent = case mc of
      MCText _ -> False
      MCFile _ -> False
      MCLink {} -> True
      MCImage {} -> True
      MCVideo {} -> True
      MCVoice {} -> False
      MCReport {} -> False
      MCChat {} -> True
      MCUnknown {} -> True
    qText = msgContentText qmc
    getFileName :: CIFile d -> String
    getFileName CIFile {fileName} = fileName
    qFileName = maybe qText (T.pack . getFileName) ciFile_
    qTextOrFile = if T.null qText then qFileName else qText

prohibitedGroupContent :: GroupInfo -> GroupMember -> Maybe GroupChatScopeInfo -> MsgContent -> Maybe MarkdownList -> Maybe f -> Bool -> Maybe GroupFeature
prohibitedGroupContent gInfo@GroupInfo {membership = GroupMember {memberRole = userRole}} m scopeInfo mc ft file_ sent
  | isVoice mc && not (groupFeatureMemberAllowed SGFVoice m gInfo) = Just GFVoice
  | isNothing scopeInfo && not (isVoice mc) && isJust file_ && not (groupFeatureMemberAllowed SGFFiles m gInfo) = Just GFFiles
  | isNothing scopeInfo && isReport mc && (badReportUser || not (groupFeatureAllowed SGFReports gInfo)) = Just GFReports
  | isNothing scopeInfo && prohibitedSimplexLinks gInfo m ft = Just GFSimplexLinks
  | otherwise = Nothing
  where
    -- admins cannot send reports, non-admins cannot receive reports
    badReportUser
      | sent = userRole >= GRModerator
      | otherwise = userRole < GRModerator

prohibitedSimplexLinks :: GroupInfo -> GroupMember -> Maybe MarkdownList -> Bool
prohibitedSimplexLinks gInfo m ft =
  not (groupFeatureMemberAllowed SGFSimplexLinks m gInfo)
    && maybe False (any ftIsSimplexLink) ft
  where
    ftIsSimplexLink :: FormattedText -> Bool
    ftIsSimplexLink FormattedText {format} = maybe False isSimplexLink format

roundedFDCount :: Int -> Int
roundedFDCount n
  | n <= 0 = 4
  | otherwise = max 4 $ fromIntegral $ (2 :: Integer) ^ (ceiling (logBase 2 (fromIntegral n) :: Double) :: Integer)

xftpSndFileTransfer_ :: User -> CryptoFile -> Integer -> Int -> Maybe ContactOrGroup -> CM (FileInvitation, CIFile 'MDSnd, FileTransferMeta)
xftpSndFileTransfer_ user file@(CryptoFile filePath cfArgs) fileSize n contactOrGroup_ = do
  let fileName = takeFileName filePath
      fInv = xftpFileInvitation fileName fileSize dummyFileDescr
  fsFilePath <- lift $ toFSFilePath filePath
  let srcFile = CryptoFile fsFilePath cfArgs
  aFileId <- withAgent $ \a -> xftpSendFile a (aUserId user) srcFile (roundedFDCount n)
  -- TODO CRSndFileStart event for XFTP
  chSize <- asks $ fileChunkSize . config
  ft@FileTransferMeta {fileId} <- withStore' $ \db -> createSndFileTransferXFTP db user contactOrGroup_ file fInv (AgentSndFileId aFileId) Nothing chSize
  let fileSource = Just $ CryptoFile filePath cfArgs
      ciFile = CIFile {fileId, fileName, fileSize, fileSource, fileStatus = CIFSSndStored, fileProtocol = FPXFTP}
  pure (fInv, ciFile, ft)

xftpSndFileRedirect :: User -> FileTransferId -> ValidFileDescription 'FRecipient -> CM FileTransferMeta
xftpSndFileRedirect user ftId vfd = do
  let fileName = "redirect.yaml"
      file = CryptoFile fileName Nothing
      fInv = xftpFileInvitation fileName (fromIntegral $ B.length $ strEncode vfd) dummyFileDescr
  aFileId <- withAgent $ \a -> xftpSendDescription a (aUserId user) vfd (roundedFDCount 1)
  chSize <- asks $ fileChunkSize . config
  withStore' $ \db -> createSndFileTransferXFTP db user Nothing file fInv (AgentSndFileId aFileId) (Just ftId) chSize

dummyFileDescr :: FileDescr
dummyFileDescr = FileDescr {fileDescrText = "", fileDescrPartNo = 0, fileDescrComplete = False}

cancelFilesInProgress :: User -> [CIFileInfo] -> CM ()
cancelFilesInProgress user filesInfo = do
  let filesInfo' = filter (not . fileEnded) filesInfo
  (sfs, rfs) <- lift $ splitFTTypes <$> withStoreBatch (\db -> map (getFT db) filesInfo')
  forM_ rfs $ \RcvFileTransfer {fileId} -> lift (closeFileHandle fileId rcvFiles) `catchAllErrors` \_ -> pure ()
  lift . void . withStoreBatch' $ \db -> map (updateSndFileCancelled db) sfs
  lift . void . withStoreBatch' $ \db -> map (updateRcvFileCancelled db) rfs
  let xsfIds = mapMaybe (\(FileTransferMeta {fileId, xftpSndFile}, _) -> (,fileId) <$> xftpSndFile) sfs
      xrfIds = mapMaybe (\RcvFileTransfer {fileId, xftpRcvFile} -> (,fileId) <$> xftpRcvFile) rfs
  lift $ agentXFTPDeleteSndFilesRemote user xsfIds
  lift $ agentXFTPDeleteRcvFiles xrfIds
  let smpSFConnIds = concatMap (\(ft, sfts) -> mapMaybe (smpSndFileConnId ft) sfts) sfs
      smpRFConnIds = mapMaybe smpRcvFileConnId rfs
  deleteAgentConnectionsAsync smpSFConnIds
  deleteAgentConnectionsAsync smpRFConnIds
  where
    fileEnded CIFileInfo {fileStatus} = case fileStatus of
      Just (AFS _ status) -> ciFileEnded status
      Nothing -> True
    getFT :: DB.Connection -> CIFileInfo -> IO (Either ChatError FileTransfer)
    getFT db CIFileInfo {fileId} = runExceptT . withExceptT ChatErrorStore $ getFileTransfer db user fileId
    updateSndFileCancelled :: DB.Connection -> (FileTransferMeta, [SndFileTransfer]) -> IO ()
    updateSndFileCancelled db (FileTransferMeta {fileId}, sfts) = do
      updateFileCancelled db user fileId CIFSSndCancelled
      forM_ sfts updateSndFTCancelled
      where
        updateSndFTCancelled :: SndFileTransfer -> IO ()
        updateSndFTCancelled ft = unless (sndFTEnded ft) $ do
          updateSndFileStatus db ft FSCancelled
          deleteSndFileChunks db ft
    updateRcvFileCancelled :: DB.Connection -> RcvFileTransfer -> IO ()
    updateRcvFileCancelled db ft@RcvFileTransfer {fileId} = do
      updateFileCancelled db user fileId CIFSRcvCancelled
      updateRcvFileStatus db fileId FSCancelled
      deleteRcvFileChunks db ft
    splitFTTypes :: [Either ChatError FileTransfer] -> ([(FileTransferMeta, [SndFileTransfer])], [RcvFileTransfer])
    splitFTTypes = foldr addFT ([], []) . rights
      where
        addFT f (sfs, rfs) = case f of
          FTSnd ft@FileTransferMeta {cancelled} sfts | not cancelled -> ((ft, sfts) : sfs, rfs)
          FTRcv ft@RcvFileTransfer {cancelled} | not cancelled -> (sfs, ft : rfs)
          _ -> (sfs, rfs)
    smpSndFileConnId :: FileTransferMeta -> SndFileTransfer -> Maybe ConnId
    smpSndFileConnId FileTransferMeta {xftpSndFile} sft@SndFileTransfer {agentConnId = AgentConnId acId, fileInline}
      | isNothing xftpSndFile && isNothing fileInline && not (sndFTEnded sft) = Just acId
      | otherwise = Nothing
    smpRcvFileConnId :: RcvFileTransfer -> Maybe ConnId
    smpRcvFileConnId ft@RcvFileTransfer {xftpRcvFile, rcvFileInline}
      | isNothing xftpRcvFile && isNothing rcvFileInline = liveRcvFileTransferConnId ft
      | otherwise = Nothing
    sndFTEnded SndFileTransfer {fileStatus} = fileStatus == FSCancelled || fileStatus == FSComplete

deleteFilesLocally :: [CIFileInfo] -> CM ()
deleteFilesLocally files =
  withFilesFolder $ \filesFolder ->
    liftIO . forM_ files $ \CIFileInfo {filePath} ->
      mapM_ (delete . (filesFolder </>)) filePath
  where
    delete :: FilePath -> IO ()
    delete fPath =
      removeFile fPath `catchAll` \_ ->
        removePathForcibly fPath `catchAll_` pure ()
    -- perform an action only if filesFolder is set (i.e. on mobile devices)
    withFilesFolder :: (FilePath -> CM ()) -> CM ()
    withFilesFolder action = asks filesFolder >>= readTVarIO >>= mapM_ action

deleteDirectCIs :: User -> Contact -> [CChatItem 'CTDirect] -> CM [ChatItemDeletion]
deleteDirectCIs user ct items = do
  let ciFilesInfo = mapMaybe (\(CChatItem _ ChatItem {file}) -> mkCIFileInfo <$> file) items
  deleteCIFiles user ciFilesInfo
  (errs, deletions) <- lift $ partitionEithers <$> withStoreBatch' (\db -> map (deleteItem db) items)
  unless (null errs) $ toView $ CEvtChatErrors errs
  pure deletions
  where
    deleteItem db (CChatItem md ci) = do
      deleteDirectChatItem db user ct ci
      pure $ contactDeletion md ct ci Nothing

deleteGroupCIs :: User -> GroupInfo -> Maybe GroupChatScopeInfo -> [CChatItem 'CTGroup] -> Maybe GroupMember -> UTCTime -> CM [ChatItemDeletion]
deleteGroupCIs user gInfo chatScopeInfo items byGroupMember_ deletedTs = do
  let ciFilesInfo = mapMaybe (\(CChatItem _ ChatItem {file}) -> mkCIFileInfo <$> file) items
  deleteCIFiles user ciFilesInfo
  (errs, deletions) <- lift $ partitionEithers <$> withStoreBatch' (\db -> map (deleteItem db) items)
  unless (null errs) $ toView $ CEvtChatErrors errs
  vr <- chatVersionRange
  deletions' <- case chatScopeInfo of
    Nothing -> pure deletions
    Just scopeInfo@GCSIMemberSupport {groupMember_} -> do
      let decStats = countDeletedUnreadItems groupMember_ deletions
      gInfo' <- withFastStore' $ \db -> updateGroupScopeUnreadStats db vr user gInfo scopeInfo decStats
      pure $ map (updateDeletionGroupInfo gInfo') deletions
  pure deletions'
  where
    deleteItem :: DB.Connection -> CChatItem 'CTGroup -> IO ChatItemDeletion
    deleteItem db (CChatItem md ci) = do
      ci' <- case byGroupMember_ of
        Just m -> Just <$> updateGroupChatItemModerated db user gInfo ci m deletedTs
        Nothing -> Nothing <$ deleteGroupChatItem db user gInfo ci
      pure $ groupDeletion md gInfo chatScopeInfo ci ci'
    countDeletedUnreadItems :: Maybe GroupMember -> [ChatItemDeletion] -> (Int, Int, Int)
    countDeletedUnreadItems scopeMember_ = foldl' countItem (0, 0, 0)
      where
        countItem :: (Int, Int, Int) -> ChatItemDeletion -> (Int, Int, Int)
        countItem (!unread, !unanswered, !mentions) ChatItemDeletion {deletedChatItem}
          | aChatItemIsRcvNew deletedChatItem =
              let unread' = unread + 1
                  unanswered' = case (scopeMember_, aChatItemRcvFromMember deletedChatItem) of
                    (Just scopeMember, Just rcvFromMember)
                      | groupMemberId' rcvFromMember == groupMemberId' scopeMember -> unanswered + 1
                    _ -> unanswered
                  mentions' = if isACIUserMention deletedChatItem then mentions + 1 else mentions
               in (unread', unanswered', mentions')
          | otherwise = (unread, unanswered, mentions)
    updateDeletionGroupInfo :: GroupInfo -> ChatItemDeletion -> ChatItemDeletion
    updateDeletionGroupInfo gInfo' ChatItemDeletion {deletedChatItem, toChatItem} =
      ChatItemDeletion
        { deletedChatItem = updateACIGroupInfo gInfo' deletedChatItem,
          toChatItem = updateACIGroupInfo gInfo' <$> toChatItem
        }

updateACIGroupInfo :: GroupInfo -> AChatItem -> AChatItem
updateACIGroupInfo gInfo' = \case
  AChatItem SCTGroup dir (GroupChat _gInfo chatScopeInfo) ci ->
    AChatItem SCTGroup dir (GroupChat gInfo' chatScopeInfo) ci
  aci -> aci

deleteGroupMemberCIs :: MsgDirectionI d => User -> GroupInfo -> GroupMember -> GroupMember -> SMsgDirection d -> CM ()
deleteGroupMemberCIs user gInfo member byGroupMember msgDir = do
  deletedTs <- liftIO getCurrentTime
  filesInfo <- withStore' $ \db -> deleteGroupMemberCIs_ db user gInfo member byGroupMember msgDir deletedTs
  deleteCIFiles user filesInfo

deleteGroupMembersCIs :: User -> GroupInfo -> [GroupMember] -> GroupMember -> CM ()
deleteGroupMembersCIs user gInfo members byGroupMember = do
  deletedTs <- liftIO getCurrentTime
  filesInfo <- withStore' $ \db -> fmap concat $ forM members $ \m -> deleteGroupMemberCIs_ db user gInfo m byGroupMember SMDRcv deletedTs
  deleteCIFiles user filesInfo

deleteGroupMemberCIs_ :: MsgDirectionI d => DB.Connection -> User -> GroupInfo -> GroupMember -> GroupMember -> SMsgDirection d -> UTCTime -> IO [CIFileInfo]
deleteGroupMemberCIs_ db user gInfo member byGroupMember msgDir deletedTs = do
  fs <- getGroupMemberFileInfo db user gInfo member
  updateMemberCIsModerated db user gInfo member byGroupMember msgDir deletedTs
  pure fs

deleteLocalCIs :: User -> NoteFolder -> [CChatItem 'CTLocal] -> Bool -> Bool -> CM ChatResponse
deleteLocalCIs user nf items byUser timed = do
  let ciFilesInfo = mapMaybe (\(CChatItem _ ChatItem {file}) -> mkCIFileInfo <$> file) items
  deleteFilesLocally ciFilesInfo
  (errs, deletions) <- lift $ partitionEithers <$> withStoreBatch' (\db -> map (deleteItem db) items)
  unless (null errs) $ toView $ CEvtChatErrors errs
  pure $ CRChatItemsDeleted user deletions byUser timed
  where
    deleteItem db (CChatItem md ci) = do
      deleteLocalChatItem db user nf ci
      pure $ ChatItemDeletion (nfItem md ci) Nothing
    nfItem :: MsgDirectionI d => SMsgDirection d -> ChatItem 'CTLocal d -> AChatItem
    nfItem md = AChatItem SCTLocal md (LocalChat nf)

deleteCIFiles :: User -> [CIFileInfo] -> CM ()
deleteCIFiles user filesInfo = do
  cancelFilesInProgress user filesInfo
  deleteFilesLocally filesInfo

markDirectCIsDeleted :: User -> Contact -> [CChatItem 'CTDirect] -> UTCTime -> CM [ChatItemDeletion]
markDirectCIsDeleted user ct items deletedTs = do
  let ciFilesInfo = mapMaybe (\(CChatItem _ ChatItem {file}) -> mkCIFileInfo <$> file) items
  cancelFilesInProgress user ciFilesInfo
  (errs, deletions) <- lift $ partitionEithers <$> withStoreBatch' (\db -> map (markDeleted db) items)
  unless (null errs) $ toView $ CEvtChatErrors errs
  pure deletions
  where
    markDeleted db (CChatItem md ci) = do
      ci' <- markDirectChatItemDeleted db user ct ci deletedTs
      pure $ contactDeletion md ct ci (Just ci')

markGroupCIsDeleted :: User -> GroupInfo -> Maybe GroupChatScopeInfo -> [CChatItem 'CTGroup] -> Maybe GroupMember -> UTCTime -> CM [ChatItemDeletion]
markGroupCIsDeleted user gInfo chatScopeInfo items byGroupMember_ deletedTs = do
  let ciFilesInfo = mapMaybe (\(CChatItem _ ChatItem {file}) -> mkCIFileInfo <$> file) items
  cancelFilesInProgress user ciFilesInfo
  (errs, deletions) <- lift $ partitionEithers <$> withStoreBatch' (\db -> map (markDeleted db) items)
  unless (null errs) $ toView $ CEvtChatErrors errs
  pure deletions
  -- pure $ CRChatItemsDeleted user deletions byUser False
  where
    markDeleted db (CChatItem md ci) = do
      ci' <- markGroupChatItemDeleted db user gInfo ci byGroupMember_ deletedTs
      pure $ groupDeletion md gInfo chatScopeInfo ci (Just ci')

markGroupMemberCIsDeleted :: User -> GroupInfo -> GroupMember -> GroupMember -> CM ()
markGroupMemberCIsDeleted user gInfo member byGroupMember = do
  deletedTs <- liftIO getCurrentTime
  filesInfo <- withStore' $ \db -> markGroupMemberCIsDeleted_ db user gInfo member byGroupMember deletedTs
  cancelFilesInProgress user filesInfo

markGroupMembersCIsDeleted :: User -> GroupInfo -> [GroupMember] -> GroupMember -> CM ()
markGroupMembersCIsDeleted user gInfo members byGroupMember = do
  deletedTs <- liftIO getCurrentTime
  filesInfo <- withStore' $ \db -> fmap concat $ forM members $ \m -> markGroupMemberCIsDeleted_ db user gInfo m byGroupMember deletedTs
  cancelFilesInProgress user filesInfo

markGroupMemberCIsDeleted_ :: DB.Connection -> User -> GroupInfo -> GroupMember -> GroupMember -> UTCTime -> IO [CIFileInfo]
markGroupMemberCIsDeleted_ db user gInfo member byGroupMember deletedTs = do
  fs <- getGroupMemberFileInfo db user gInfo member
  markMemberCIsDeleted db user gInfo member byGroupMember deletedTs
  pure fs

groupDeletion :: MsgDirectionI d => SMsgDirection d -> GroupInfo -> Maybe GroupChatScopeInfo -> ChatItem 'CTGroup d -> Maybe (ChatItem 'CTGroup d) -> ChatItemDeletion
groupDeletion md g chatScopeInfo ci ci' = ChatItemDeletion (gItem ci) (gItem <$> ci')
  where
    gItem = AChatItem SCTGroup md (GroupChat g chatScopeInfo)

contactDeletion :: MsgDirectionI d => SMsgDirection d -> Contact -> ChatItem 'CTDirect d -> Maybe (ChatItem 'CTDirect d) -> ChatItemDeletion
contactDeletion md ct ci ci' = ChatItemDeletion (ctItem ci) (ctItem <$> ci')
  where
    ctItem = AChatItem SCTDirect md (DirectChat ct)

updateCallItemStatus :: User -> Contact -> Call -> WebRTCCallStatus -> Maybe MessageId -> CM ()
updateCallItemStatus user ct@Contact {contactId} Call {chatItemId} receivedStatus msgId_ = do
  aciContent_ <- callStatusItemContent user ct chatItemId receivedStatus
  forM_ aciContent_ $ \aciContent -> do
    timed_ <- callTimed ct aciContent
    updateDirectChatItemView user ct chatItemId aciContent False False timed_ msgId_
    forM_ (timed_ >>= timedDeleteAt') $
      startProximateTimedItemThread user (ChatRef CTDirect contactId Nothing, chatItemId)

updateDirectChatItemView :: User -> Contact -> ChatItemId -> ACIContent -> Bool -> Bool -> Maybe CITimed -> Maybe MessageId -> CM ()
updateDirectChatItemView user ct chatItemId (ACIContent msgDir ciContent) edited live timed_ msgId_ = do
  ci' <- withStore $ \db -> updateDirectChatItem db user ct chatItemId ciContent edited live timed_ msgId_
  toView $ CEvtChatItemUpdated user (AChatItem SCTDirect msgDir (DirectChat ct) ci')

callStatusItemContent :: User -> Contact -> ChatItemId -> WebRTCCallStatus -> CM (Maybe ACIContent)
callStatusItemContent user Contact {contactId} chatItemId receivedStatus = do
  CChatItem msgDir ChatItem {meta = CIMeta {updatedAt}, content} <-
    withStore $ \db -> getDirectChatItem db user contactId chatItemId
  ts <- liftIO getCurrentTime
  let callDuration :: Int = nominalDiffTimeToSeconds (ts `diffUTCTime` updatedAt) `div'` 1
      callStatus = case content of
        CISndCall st _ -> Just st
        CIRcvCall st _ -> Just st
        _ -> Nothing
      newState_ = case (callStatus, receivedStatus) of
        (Just CISCallProgress, WCSConnected) -> Nothing -- if call in-progress received connected -> no change
        (Just CISCallProgress, WCSDisconnected) -> Just (CISCallEnded, callDuration) -- calculate in-progress duration
        (Just CISCallProgress, WCSFailed) -> Just (CISCallEnded, callDuration) -- whether call disconnected or failed
        (Just CISCallPending, WCSDisconnected) -> Just (CISCallMissed, 0)
        (Just CISCallEnded, _) -> Nothing -- if call already ended or failed -> no change
        (Just CISCallError, _) -> Nothing
        (Just _, WCSConnecting) -> Just (CISCallNegotiated, 0)
        (Just _, WCSConnected) -> Just (CISCallProgress, 0) -- if call ended that was never connected, duration = 0
        (Just _, WCSDisconnected) -> Just (CISCallEnded, 0)
        (Just _, WCSFailed) -> Just (CISCallError, 0)
        (Nothing, _) -> Nothing -- some other content - we should never get here, but no exception is thrown
  pure $ aciContent msgDir <$> newState_
  where
    aciContent :: forall d. SMsgDirection d -> (CICallStatus, Int) -> ACIContent
    aciContent msgDir (callStatus', duration) = case msgDir of
      SMDSnd -> ACIContent SMDSnd $ CISndCall callStatus' duration
      SMDRcv -> ACIContent SMDRcv $ CIRcvCall callStatus' duration

-- mobile clients use file paths relative to app directory (e.g. for the reason ios app directory changes on updates),
-- so we have to differentiate between the file path stored in db and communicated with frontend, and the file path
-- used during file transfer for actual operations with file system
toFSFilePath :: FilePath -> CM' FilePath
toFSFilePath f =
  maybe f (</> f) <$> (chatReadVar' filesFolder)

setFileToEncrypt :: RcvFileTransfer -> CM RcvFileTransfer
setFileToEncrypt ft@RcvFileTransfer {fileId} = do
  cfArgs <- atomically . CF.randomArgs =<< asks random
  withStore' $ \db -> setFileCryptoArgs db fileId cfArgs
  pure (ft :: RcvFileTransfer) {cryptoArgs = Just cfArgs}

receiveFile' :: User -> RcvFileTransfer -> Bool -> Maybe Bool -> Maybe FilePath -> CM ChatResponse
receiveFile' user ft userApprovedRelays rcvInline_ filePath_ = do
  (CRRcvFileAccepted user <$> acceptFileReceive user ft userApprovedRelays rcvInline_ filePath_) `catchAllErrors` processError
  where
    -- TODO AChatItem in Cancelled events
    processError e
      | rctFileCancelled e = pure $ CRRcvFileAcceptedSndCancelled user ft
      | otherwise = throwError e

receiveFileEvt' :: User -> RcvFileTransfer -> Bool -> Maybe Bool -> Maybe FilePath -> CM ChatEvent
receiveFileEvt' user ft userApprovedRelays rcvInline_ filePath_ = do
  (CEvtRcvFileAccepted user <$> acceptFileReceive user ft userApprovedRelays rcvInline_ filePath_) `catchAllErrors` processError
  where
    -- TODO AChatItem in Cancelled events
    processError e
      | rctFileCancelled e = pure $ CEvtRcvFileAcceptedSndCancelled user ft
      | otherwise = throwError e

rctFileCancelled :: ChatError -> Bool
rctFileCancelled = \case
  ChatErrorAgent (SMP _ SMP.AUTH) _ -> True
  ChatErrorAgent (CONN DUPLICATE _) _ -> True
  _ -> False

acceptFileReceive :: User -> RcvFileTransfer -> Bool -> Maybe Bool -> Maybe FilePath -> CM AChatItem
acceptFileReceive user@User {userId} RcvFileTransfer {fileId, xftpRcvFile, fileInvitation = FileInvitation {fileName = fName, fileConnReq, fileInline, fileSize}, fileStatus, grpMemberId, cryptoArgs} userApprovedRelays rcvInline_ filePath_ = do
  unless (fileStatus == RFSNew) $ case fileStatus of
    RFSCancelled _ -> throwChatError $ CEFileCancelled fName
    _ -> throwChatError $ CEFileAlreadyReceiving fName
  vr <- chatVersionRange
  case (xftpRcvFile, fileConnReq) of
    -- direct file protocol
    (Nothing, Just connReq) -> do
      subMode <- chatReadVar subscriptionMode
      dm <- encodeConnInfo $ XFileAcpt fName
      connIds <- joinAgentConnectionAsync user True connReq dm subMode
      filePath <- getRcvFilePath fileId filePath_ fName True
      withStore $ \db -> acceptRcvFileTransfer db vr user fileId connIds ConnJoined filePath subMode
    -- XFTP
    (Just XFTPRcvFile {userApprovedRelays = approvedBeforeReady}, _) -> do
      let userApproved = approvedBeforeReady || userApprovedRelays
      filePath <- getRcvFilePath fileId filePath_ fName False
      (ci, rfd) <- withStore $ \db -> do
        -- marking file as accepted and reading description in the same transaction
        -- to prevent race condition with appending description
        ci <- xftpAcceptRcvFT db vr user fileId filePath userApproved
        rfd <- getRcvFileDescrByRcvFileId db fileId
        pure (ci, rfd)
      receiveViaCompleteFD user fileId rfd userApproved cryptoArgs
      pure ci
    -- group & direct file protocol
    _ -> do
      chatRef <- withStore $ \db -> getChatRefByFileId db user fileId
      case (chatRef, grpMemberId) of
        (ChatRef CTDirect contactId _, Nothing) -> do
          ct <- withStore $ \db -> getContact db vr user contactId
          acceptFile CFCreateConnFileInvDirect $ \msg -> void $ sendDirectContactMessage user ct msg
        (ChatRef CTGroup groupId _, Just memId) -> do
          GroupMember {activeConn} <- withStore $ \db -> getGroupMember db vr user groupId memId
          case activeConn of
            Just conn -> do
              acceptFile CFCreateConnFileInvGroup $ \msg -> void $ sendDirectMemberMessage conn msg groupId
            _ -> throwChatError $ CEFileInternal "member connection not active"
        _ -> throwChatError $ CEFileInternal "invalid chat ref for file transfer"
  where
    acceptFile :: CommandFunction -> (ChatMsgEvent 'Json -> CM ()) -> CM AChatItem
    acceptFile cmdFunction send = do
      filePath <- getRcvFilePath fileId filePath_ fName True
      inline <- receiveInline
      vr <- chatVersionRange
      if
        | inline -> do
            -- accepting inline
            ci <- withStore $ \db -> acceptRcvInlineFT db vr user fileId filePath
            sharedMsgId <- withStore $ \db -> getSharedMsgIdByFileId db userId fileId
            send $ XFileAcptInv sharedMsgId Nothing fName
            pure ci
        | fileInline == Just IFMSent -> throwChatError $ CEFileAlreadyReceiving fName
        | otherwise -> do
            -- accepting via a new connection
            subMode <- chatReadVar subscriptionMode
            connIds <- createAgentConnectionAsync user cmdFunction True SCMInvitation subMode
            withStore $ \db -> acceptRcvFileTransfer db vr user fileId connIds ConnNew filePath subMode
    receiveInline :: CM Bool
    receiveInline = do
      ChatConfig {fileChunkSize, inlineFiles = InlineFilesConfig {receiveChunks, offerChunks}} <- asks config
      pure $
        rcvInline_ /= Just False
          && fileInline == Just IFMOffer
          && ( fileSize <= fileChunkSize * receiveChunks
                || (rcvInline_ == Just True && fileSize <= fileChunkSize * offerChunks)
             )

receiveViaCompleteFD :: User -> FileTransferId -> RcvFileDescr -> Bool -> Maybe CryptoFileArgs -> CM ()
receiveViaCompleteFD user fileId RcvFileDescr {fileDescrText, fileDescrComplete} userApprovedRelays cfArgs =
  when fileDescrComplete $ do
    rd <- parseFileDescription fileDescrText
    if userApprovedRelays
      then receive' rd True
      else do
        let srvs = fileServers rd
        unknownSrvs <- getUnknownSrvs srvs
        let approved = null unknownSrvs
        ifM
          ((approved ||) <$> ipProtectedForSrvs srvs)
          (receive' rd approved)
          (relaysNotApproved unknownSrvs)
  where
    receive' :: ValidFileDescription 'FRecipient -> Bool -> CM ()
    receive' rd approved = do
      aFileId <- withAgent $ \a -> xftpReceiveFile a (aUserId user) rd cfArgs approved
      startReceivingFile user fileId
      withStore' $ \db -> updateRcvFileAgentId db fileId (Just $ AgentRcvFileId aFileId)
    fileServers :: ValidFileDescription 'FRecipient -> [XFTPServer]
    fileServers (FD.ValidFileDescription FD.FileDescription {chunks}) =
      S.toList $ S.fromList $ concatMap (\FD.FileChunk {replicas} -> map (\FD.FileChunkReplica {server} -> server) replicas) chunks
    getUnknownSrvs :: [XFTPServer] -> CM [XFTPServer]
    getUnknownSrvs srvs = do
      knownSrvs <- L.map protoServer' <$> getKnownAgentServers SPXFTP user
      pure $ filter (`notElem` knownSrvs) srvs
    ipProtectedForSrvs :: [XFTPServer] -> CM Bool
    ipProtectedForSrvs srvs = do
      netCfg <- lift getNetworkConfig
      pure $ all (ipAddressProtected netCfg) srvs
    relaysNotApproved :: [XFTPServer] -> CM ()
    relaysNotApproved unknownSrvs = do
      aci_ <- resetRcvCIFileStatus user fileId CIFSRcvInvitation
      forM_ aci_ $ \aci -> do
        cleanupACIFile aci
        toView $ CEvtChatItemUpdated user aci
      throwChatError $ CEFileNotApproved fileId unknownSrvs

cleanupACIFile :: AChatItem -> CM ()
cleanupACIFile (AChatItem _ _ _ ChatItem {file = Just CIFile {fileSource = Just CryptoFile {filePath}}}) = do
  fsFilePath <- lift $ toFSFilePath filePath
  removeFile fsFilePath `catchAllErrors` \_ -> pure ()
cleanupACIFile _ = pure ()

getKnownAgentServers :: (ProtocolTypeI p, UserProtocol p) => SProtocolType p -> User -> CM (NonEmpty (ServerCfg p))
getKnownAgentServers p user = do
  as <- asks randomAgentServers
  withStore $ \db -> do
    opDomains <- operatorDomains . serverOperators <$> getServerOperators db
    srvs <- liftIO $ getProtocolServers db p user
    pure $ useServerCfgs p as opDomains srvs

protoServer' :: ServerCfg p -> ProtocolServer p
protoServer' ServerCfg {server} = protoServer server

getNetworkConfig :: CM' NetworkConfig
getNetworkConfig = withAgent' $ liftIO . getFastNetworkConfig

resetRcvCIFileStatus :: User -> FileTransferId -> CIFileStatus 'MDRcv -> CM (Maybe AChatItem)
resetRcvCIFileStatus user fileId ciFileStatus = do
  vr <- chatVersionRange
  withStore $ \db -> do
    liftIO $ do
      updateCIFileStatus db user fileId ciFileStatus
      updateRcvFileStatus db fileId FSNew
      updateRcvFileAgentId db fileId Nothing
    lookupChatItemByFileId db vr user fileId

receiveViaURI :: User -> FileDescriptionURI -> CryptoFile -> CM RcvFileTransfer
receiveViaURI user@User {userId} FileDescriptionURI {description} cf@CryptoFile {cryptoArgs} = do
  fileId <- withStore $ \db -> createRcvStandaloneFileTransfer db userId cf fileSize chunkSize
  -- currently the only use case is user migrating via their configured servers, so we pass approvedRelays = True
  aFileId <- withAgent $ \a -> xftpReceiveFile a (aUserId user) description cryptoArgs True
  withStore $ \db -> do
    liftIO $ do
      updateRcvFileStatus db fileId FSConnected
      updateCIFileStatus db user fileId $ CIFSRcvTransfer 0 1
      updateRcvFileAgentId db fileId (Just $ AgentRcvFileId aFileId)
    getRcvFileTransfer db user fileId
  where
    FD.ValidFileDescription FD.FileDescription {size = FD.FileSize fileSize, chunkSize = FD.FileSize chunkSize} = description

startReceivingFile :: User -> FileTransferId -> CM ()
startReceivingFile user fileId = do
  vr <- chatVersionRange
  ci <- withStore $ \db -> do
    liftIO $ updateRcvFileStatus db fileId FSConnected
    liftIO $ updateCIFileStatus db user fileId $ CIFSRcvTransfer 0 1
    getChatItemByFileId db vr user fileId
  toView $ CEvtRcvFileStart user ci

getRcvFilePath :: FileTransferId -> Maybe FilePath -> String -> Bool -> CM FilePath
getRcvFilePath fileId fPath_ fn keepHandle = case fPath_ of
  Nothing ->
    chatReadVar filesFolder >>= \case
      Nothing -> do
        defaultFolder <- lift getDefaultFilesFolder
        fPath <- liftIO $ defaultFolder `uniqueCombine` fn
        createEmptyFile fPath $> fPath
      Just filesFolder -> do
        fPath <- liftIO $ filesFolder `uniqueCombine` fn
        createEmptyFile fPath
        pure $ takeFileName fPath
  Just fPath ->
    ifM
      (doesDirectoryExist fPath)
      (createInPassedDirectory fPath)
      $ ifM
        (doesFileExist fPath)
        (throwChatError $ CEFileAlreadyExists fPath)
        (createEmptyFile fPath $> fPath)
  where
    createInPassedDirectory :: FilePath -> CM FilePath
    createInPassedDirectory fPathDir = do
      fPath <- liftIO $ fPathDir `uniqueCombine` fn
      createEmptyFile fPath $> fPath
    createEmptyFile :: FilePath -> CM ()
    createEmptyFile fPath = emptyFile `catchThrow` (ChatError . CEFileWrite fPath . show)
      where
        emptyFile :: CM ()
        emptyFile
          | keepHandle = do
              h <- getFileHandle fileId fPath rcvFiles AppendMode
              liftIO $ B.hPut h "" >> hFlush h
          | otherwise = liftIO $ B.writeFile fPath ""

-- TODO [short links]
-- Please note:
-- - the connection here is created as ConnNew, even though when joining it is created as ConnPrepared.
--   (changing it is risky, as there may be existing "prepared" connections that were not accepted in ConnNew status).
-- - after accepted, the status is changed by this func caller to ConnSndReady if it is sndSecure, and not changed otherwise - joined changed to ConnJoined in this case.
-- - xContactId is set on the contact at the first acceptance attempt, not after accept success, which prevents profile updates after such attempt.
--   It may be reasonable to set it when contact is first prepared, but then we can't use it to ignore requests after acceptance,
--   and it may lead to race conditions with XInfo events.
acceptContactRequest :: NetworkRequestMode -> User -> UserContactRequest -> IncognitoEnabled -> CM (Contact, Connection, SndQueueSecured)
acceptContactRequest nm user@User {userId} UserContactRequest {agentInvitationId = AgentInvId invId, contactId_, cReqChatVRange, localDisplayName = cName, profileId, profile = cp, userContactLinkId_, xContactId, pqSupport} incognito = do
  subMode <- chatReadVar subscriptionMode
  let pqSup = PQSupportOn
      pqSup' = pqSup `CR.pqSupportAnd` pqSupport
  vr <- chatVersionRange
  let chatV = vr `peerConnChatVersion` cReqChatVRange
  (ct, conn, incognitoProfile) <- case contactId_ of
    Nothing -> do
      incognitoProfile <- if incognito then Just . NewIncognito <$> liftIO generateRandomProfile else pure Nothing
      connId <- withAgent $ \a -> prepareConnectionToAccept a (aUserId user) True invId pqSup'
      (ct, conn) <- withStore' $ \db ->
        createContactFromRequest db user userContactLinkId_ connId chatV cReqChatVRange cName profileId cp xContactId incognitoProfile subMode pqSup' False
      pure (ct, conn, incognitoProfile)
    Just contactId -> do
      ct <- withFastStore $ \db -> getContact db vr user contactId
      case contactConn ct of
        Nothing -> do
          incognitoProfile <- if incognito then Just . NewIncognito <$> liftIO generateRandomProfile else pure Nothing
          connId <- withAgent $ \a -> prepareConnectionToAccept a (aUserId user) True invId pqSup'
          currentTs <- liftIO getCurrentTime
          conn <- withStore' $ \db -> do
            forM_ xContactId $ \xcId -> setContactAcceptedXContactId db ct xcId
            createAcceptedContactConn db user userContactLinkId_ contactId connId chatV cReqChatVRange pqSup' incognitoProfile subMode currentTs
          pure (ct {activeConn = Just conn} :: Contact, conn, incognitoProfile)
        Just conn@Connection {customUserProfileId} -> do
          incognitoProfile <- forM customUserProfileId $ \pId -> withFastStore $ \db -> getProfileById db userId pId
          pure (ct, conn, ExistingIncognito <$> incognitoProfile)
  let profileToSend = userProfileDirect user (fromIncognitoProfile <$> incognitoProfile) (Just ct) True
  dm <- encodeConnInfoPQ pqSup' chatV $ XInfo profileToSend
  -- TODO [certs rcv]
  (ct,conn,) . fst <$> withAgent (\a -> acceptContact a nm (aUserId user) (aConnId conn) True invId dm pqSup' subMode)

acceptContactRequestAsync :: User -> Int64 -> Contact -> UserContactRequest -> Maybe IncognitoProfile -> CM Contact
acceptContactRequestAsync
  user
  uclId
  ct@Contact {contactId}
  UserContactRequest {agentInvitationId = AgentInvId cReqInvId, cReqChatVRange, xContactId, pqSupport = cReqPQSup}
  incognitoProfile = do
    subMode <- chatReadVar subscriptionMode
    let profileToSend = userProfileDirect user (fromIncognitoProfile <$> incognitoProfile) (Just ct) True
    vr <- chatVersionRange
    let chatV = vr `peerConnChatVersion` cReqChatVRange
    (cmdId, acId) <- agentAcceptContactAsync user True cReqInvId (XInfo profileToSend) subMode cReqPQSup chatV
    currentTs <- liftIO getCurrentTime
    withStore $ \db -> do
      forM_ xContactId $ \xcId -> liftIO $ setContactAcceptedXContactId db ct xcId
      Connection {connId} <- liftIO $ createAcceptedContactConn db user (Just uclId) contactId acId chatV cReqChatVRange cReqPQSup incognitoProfile subMode currentTs
      liftIO $ setCommandConnId db user cmdId connId
      getContact db vr user contactId

acceptGroupJoinRequestAsync :: User -> Int64 -> GroupInfo -> InvitationId -> VersionRangeChat -> Profile -> Maybe XContactId -> Maybe SharedMsgId -> GroupAcceptance -> GroupMemberRole -> Maybe IncognitoProfile -> CM GroupMember
acceptGroupJoinRequestAsync
  user
  uclId
  gInfo@GroupInfo {groupProfile, membership, businessChat}
  cReqInvId
  cReqChatVRange
  cReqProfile
  cReqXContactId_
  welcomeMsgId_
  gAccepted
  gLinkMemRole
  incognitoProfile = do
    gVar <- asks random
    let initialStatus = acceptanceToStatus (memberAdmission groupProfile) gAccepted
    (groupMemberId, memberId) <- withStore $ \db ->
      createJoiningMember db gVar user gInfo cReqChatVRange cReqProfile cReqXContactId_ welcomeMsgId_ gLinkMemRole initialStatus
    currentMemCount <- withStore' $ \db -> getGroupCurrentMembersCount db user gInfo
    let Profile {displayName} = userProfileInGroup user (fromIncognitoProfile <$> incognitoProfile)
        GroupMember {memberRole = userRole, memberId = userMemberId} = membership
        msg =
          XGrpLinkInv $
            GroupLinkInvitation
              { fromMember = MemberIdRole userMemberId userRole,
                fromMemberName = displayName,
                invitedMember = MemberIdRole memberId gLinkMemRole,
                groupProfile,
                accepted = Just gAccepted,
                business = businessChat,
                groupSize = Just currentMemCount
              }
    subMode <- chatReadVar subscriptionMode
    vr <- chatVersionRange
    let chatV = vr `peerConnChatVersion` cReqChatVRange
    connIds <- agentAcceptContactAsync user True cReqInvId msg subMode PQSupportOff chatV
    withStore $ \db -> do
      liftIO $ createJoiningMemberConnection db user uclId connIds chatV cReqChatVRange groupMemberId subMode
      getGroupMemberById db vr user groupMemberId

acceptGroupJoinSendRejectAsync :: User -> Int64 -> GroupInfo -> InvitationId -> VersionRangeChat -> Profile -> Maybe XContactId -> GroupRejectionReason -> CM GroupMember
acceptGroupJoinSendRejectAsync
  user
  uclId
  gInfo@GroupInfo {groupProfile, membership}
  cReqInvId
  cReqChatVRange
  cReqProfile
  cReqXContactId_
  rejectionReason = do
    gVar <- asks random
    (groupMemberId, memberId) <- withStore $ \db ->
      createJoiningMember db gVar user gInfo cReqChatVRange cReqProfile cReqXContactId_ Nothing GRObserver GSMemRejected
    let GroupMember {memberRole = userRole, memberId = userMemberId} = membership
        msg =
          XGrpLinkReject $
            GroupLinkRejection
              { fromMember = MemberIdRole userMemberId userRole,
                invitedMember = MemberIdRole memberId GRObserver,
                groupProfile,
                rejectionReason
              }
    subMode <- chatReadVar subscriptionMode
    vr <- chatVersionRange
    let chatV = vr `peerConnChatVersion` cReqChatVRange
    connIds <- agentAcceptContactAsync user False cReqInvId msg subMode PQSupportOff chatV
    withStore $ \db -> do
      liftIO $ createJoiningMemberConnection db user uclId connIds chatV cReqChatVRange groupMemberId subMode
      getGroupMemberById db vr user groupMemberId

acceptBusinessJoinRequestAsync :: User -> Int64 -> GroupInfo -> GroupMember -> UserContactRequest -> CM (GroupInfo, GroupMember)
acceptBusinessJoinRequestAsync
  user
  uclId
  gInfo@GroupInfo {membership = GroupMember {memberRole = userRole, memberId = userMemberId}}
  clientMember@GroupMember {groupMemberId, memberId}
  UserContactRequest {agentInvitationId = AgentInvId cReqInvId, cReqChatVRange, xContactId} = do
    vr <- chatVersionRange
    let userProfile@Profile {displayName, preferences} = fromLocalProfile $ profile' user
        -- TODO [short links] take groupPreferences from group info
        groupPreferences = maybe defaultBusinessGroupPrefs businessGroupPrefs preferences
        msg =
          XGrpLinkInv $
            GroupLinkInvitation
              { fromMember = MemberIdRole userMemberId userRole,
                fromMemberName = displayName,
                invitedMember = MemberIdRole memberId GRMember,
                groupProfile = businessGroupProfile userProfile groupPreferences,
                accepted = Just GAAccepted,
                -- This refers to the "title member" that defines the group name and profile.
                -- This coincides with fromMember to be current user when accepting the connecting user,
                -- but it will be different when inviting somebody else.
                business = Just $ BusinessChatInfo {chatType = BCBusiness, businessId = userMemberId, customerId = memberId},
                groupSize = Just 1
              }
    subMode <- chatReadVar subscriptionMode
    let chatV = vr `peerConnChatVersion` cReqChatVRange
    connIds <- agentAcceptContactAsync user True cReqInvId msg subMode PQSupportOff chatV
    withStore' $ \db -> do
      forM_ xContactId $ \xcId -> setBusinessChatAcceptedXContactId db gInfo xcId
      createJoiningMemberConnection db user uclId connIds chatV cReqChatVRange groupMemberId subMode
    let cd = CDGroupSnd gInfo Nothing
    -- TODO [short links] move to profileContactRequest?
    createInternalChatItem user cd (CISndGroupE2EEInfo E2EInfo {pqEnabled = Just PQEncOff}) Nothing
    createGroupFeatureItems user cd CISndGroupFeature gInfo
    -- TODO [short links] get updated business chat group and member? (currently not used)
    pure (gInfo, clientMember)

businessGroupProfile :: Profile -> GroupPreferences -> GroupProfile
businessGroupProfile Profile {displayName, fullName, shortDescr, image} groupPreferences =
  GroupProfile {displayName, fullName, description = Nothing, shortDescr, image, groupPreferences = Just groupPreferences, memberAdmission = Nothing}

introduceToModerators :: VersionRangeChat -> User -> GroupInfo -> GroupMember -> CM ()
introduceToModerators vr user gInfo@GroupInfo {groupId} m@GroupMember {memberRole, memberId} = do
  forM_ (memberConn m) $ \mConn -> do
    let msg =
          if (maxVersion (memberChatVRange m) >= groupKnockingVersion)
            then XGrpLinkAcpt GAPendingReview memberRole memberId
            else XMsgNew $ MCSimple $ extMsgContent (MCText pendingReviewMessage) Nothing
    void $ sendDirectMemberMessage mConn msg groupId
  modMs <- withStore' $ \db -> getGroupModerators db vr user gInfo
  let rcpModMs = filter (\mem -> memberCurrent mem && maxVersion (memberChatVRange mem) >= groupKnockingVersion) modMs
  introduceMember vr user gInfo m rcpModMs (Just $ MSMember $ memberId' m)

introduceToAll :: VersionRangeChat -> User -> GroupInfo -> GroupMember -> CM ()
introduceToAll vr user gInfo m = do
  members <- withStore' $ \db -> getGroupMembers db vr user gInfo
  let recipients = filter memberCurrent members
  introduceMember vr user gInfo m recipients Nothing

introduceToRemaining :: VersionRangeChat -> User -> GroupInfo -> GroupMember -> CM ()
introduceToRemaining vr user gInfo m = do
  (members, introducedGMIds) <-
    withStore' $ \db -> (,) <$> getGroupMembers db vr user gInfo <*> getIntroducedGroupMemberIds db m
  let recipients = filter (introduceMemP introducedGMIds) members
  introduceMember vr user gInfo m recipients Nothing
  where
    introduceMemP introducedGMIds mem =
      memberCurrent mem
        && groupMemberId' mem `notElem` introducedGMIds
        && groupMemberId' mem /= groupMemberId' m

introduceMember :: VersionRangeChat -> User -> GroupInfo -> GroupMember -> [GroupMember] -> Maybe MsgScope -> CM ()
introduceMember _ _ _ GroupMember {activeConn = Nothing} _ _ = throwChatError $ CEInternalError "member connection not active"
introduceMember vr user gInfo@GroupInfo {groupId} m@GroupMember {activeConn = Just conn} introduceToMembers msgScope = do
  void . sendGroupMessage' user gInfo introduceToMembers $ XGrpMemNew (memberInfo m) msgScope
  sendIntroductions introduceToMembers
  where
    sendIntroductions members = do
      intros <- withStore' $ \db -> createIntroductions db (maxVersion vr) members m
      shuffledIntros <- liftIO $ shuffleIntros intros
      if m `supportsVersion` batchSendVersion
        then do
          let events = map (memberIntro . reMember) shuffledIntros
          forM_ (L.nonEmpty events) $ \events' ->
            sendGroupMemberMessages user conn events' groupId
        else forM_ shuffledIntros $ \intro ->
          processIntro intro `catchAllErrors` eToView
    memberIntro :: GroupMember -> ChatMsgEvent 'Json
    memberIntro reMember =
      let mInfo = memberInfo reMember
          mRestrictions = memberRestrictions reMember
       in XGrpMemIntro mInfo mRestrictions
    shuffleIntros :: [GroupMemberIntro] -> IO [GroupMemberIntro]
    shuffleIntros intros = do
      let (admins, others) = partition isAdmin intros
          (admPics, admNoPics) = partition hasPicture admins
          (othPics, othNoPics) = partition hasPicture others
      mconcat <$> mapM shuffle [admPics, admNoPics, othPics, othNoPics]
      where
        isAdmin GroupMemberIntro {reMember = GroupMember {memberRole}} = memberRole >= GRAdmin
        hasPicture GroupMemberIntro {reMember = GroupMember {memberProfile = LocalProfile {image}}} = isJust image
    processIntro intro@GroupMemberIntro {introId} = do
      void $ sendDirectMemberMessage conn (memberIntro $ reMember intro) groupId
      withStore' $ \db -> updateIntroStatus db introId GMIntroSent

sendHistory :: User -> GroupInfo -> GroupMember -> CM ()
sendHistory _ _ GroupMember {activeConn = Nothing} = throwChatError $ CEInternalError "member connection not active"
sendHistory user gInfo@GroupInfo {groupId, membership} m@GroupMember {activeConn = Just conn} =
  when (m `supportsVersion` batchSendVersion) $ do
    (errs, items) <- partitionEithers <$> withStore' (\db -> getGroupHistoryItems db user gInfo m 100)
    (errs', events) <- partitionEithers <$> mapM (tryAllErrors . itemForwardEvents) items
    let errors = map ChatErrorStore errs <> errs'
    unless (null errors) $ toView $ CEvtChatErrors errors
    let events' = concat events
    events_ <- case descrEvent_ of
      Just descr -> mkEvents <$> withStore' (\db -> getMemberJoinRequest db user gInfo m)
        where
          mkEvents = \case
            Just (_, Just _welcomeMsgId) -> events'
            _ -> events' <> [descr]
      Nothing -> pure events'
    forM_ (L.nonEmpty events_) $ \events'' ->
      sendGroupMemberMessages user conn events'' groupId
  where
    descrEvent_ :: Maybe (ChatMsgEvent 'Json)
    descrEvent_
      | m `supportsVersion` groupHistoryIncludeWelcomeVersion = do
          let GroupInfo {groupProfile = GroupProfile {description}} = gInfo
          fmap (\descr -> XMsgNew $ MCSimple $ extMsgContent (MCText descr) Nothing) description
      | otherwise = Nothing
    itemForwardEvents :: CChatItem 'CTGroup -> CM [ChatMsgEvent 'Json]
    itemForwardEvents cci = case cci of
      (CChatItem SMDRcv ci@ChatItem {chatDir = CIGroupRcv sender, content = CIRcvMsgContent mc, file})
        | not (blockedByAdmin sender) -> do
            fInvDescr_ <- join <$> forM file getRcvFileInvDescr
            processContentItem sender ci mc fInvDescr_
      (CChatItem SMDSnd ci@ChatItem {content = CISndMsgContent mc, file}) -> do
        fInvDescr_ <- join <$> forM file getSndFileInvDescr
        processContentItem membership ci mc fInvDescr_
      _ -> pure []
      where
        getRcvFileInvDescr :: CIFile 'MDRcv -> CM (Maybe (FileInvitation, RcvFileDescrText))
        getRcvFileInvDescr ciFile@CIFile {fileId, fileProtocol, fileStatus} = do
          expired <- fileExpired
          if fileProtocol /= FPXFTP || fileStatus == CIFSRcvCancelled || expired
            then pure Nothing
            else do
              rfd <- withStore $ \db -> getRcvFileDescrByRcvFileId db fileId
              pure $ invCompleteDescr ciFile rfd
        getSndFileInvDescr :: CIFile 'MDSnd -> CM (Maybe (FileInvitation, RcvFileDescrText))
        getSndFileInvDescr ciFile@CIFile {fileId, fileProtocol, fileStatus} = do
          expired <- fileExpired
          if fileProtocol /= FPXFTP || fileStatus == CIFSSndCancelled || expired
            then pure Nothing
            else do
              -- can also lookup in extra_xftp_file_descriptions, though it can be empty;
              -- would be best if snd file had a single rcv description for all members saved in files table
              rfd <- withStore $ \db -> getRcvFileDescrBySndFileId db fileId
              pure $ invCompleteDescr ciFile rfd
        fileExpired :: CM Bool
        fileExpired = do
          ttl <- asks $ rcvFilesTTL . agentConfig . config
          cutoffTs <- addUTCTime (-ttl) <$> liftIO getCurrentTime
          pure $ chatItemTs cci < cutoffTs
        invCompleteDescr :: CIFile d -> RcvFileDescr -> Maybe (FileInvitation, RcvFileDescrText)
        invCompleteDescr CIFile {fileName, fileSize} RcvFileDescr {fileDescrText, fileDescrComplete}
          | fileDescrComplete =
              let fInvDescr = FileDescr {fileDescrText = "", fileDescrPartNo = 0, fileDescrComplete = False}
                  fInv = xftpFileInvitation fileName fileSize fInvDescr
               in Just (fInv, fileDescrText)
          | otherwise = Nothing
        processContentItem :: GroupMember -> ChatItem 'CTGroup d -> MsgContent -> Maybe (FileInvitation, RcvFileDescrText) -> CM [ChatMsgEvent 'Json]
        processContentItem sender ChatItem {formattedText, meta, quotedItem, mentions} mc fInvDescr_ =
          if isNothing fInvDescr_ && not (msgContentHasText mc)
            then pure []
            else do
              let CIMeta {itemTs, itemSharedMsgId, itemTimed} = meta
                  quotedItemId_ = quoteItemId =<< quotedItem
                  fInv_ = fst <$> fInvDescr_
                  (mc', _, mentions') = updatedMentionNames mc formattedText mentions
                  mentions'' = M.map (\CIMention {memberId} -> MsgMention {memberId}) mentions'
              -- TODO [knocking] send history to other scopes too?
              (chatMsgEvent, _) <- withStore $ \db -> prepareGroupMsg db user gInfo Nothing mc' mentions'' quotedItemId_ Nothing fInv_ itemTimed False
              let senderVRange = memberChatVRange' sender
                  xMsgNewChatMsg = ChatMessage {chatVRange = senderVRange, msgId = itemSharedMsgId, chatMsgEvent}
              fileDescrEvents <- case (snd <$> fInvDescr_, itemSharedMsgId) of
                (Just fileDescrText, Just msgId) -> do
                  partSize <- asks $ xftpDescrPartSize . config
                  let parts = splitFileDescr partSize fileDescrText
                  pure . L.toList $ L.map (XMsgFileDescr msgId) parts
                _ -> pure []
              let fileDescrChatMsgs = map (ChatMessage senderVRange Nothing) fileDescrEvents
                  GroupMember {memberId} = sender
                  memberName = Just $ memberShortenedName sender
                  msgForwardEvents = map (\cm -> XGrpMsgForward memberId memberName cm itemTs) (xMsgNewChatMsg : fileDescrChatMsgs)
              pure msgForwardEvents

memberShortenedName :: GroupMember -> ContactName
memberShortenedName GroupMember {memberProfile = LocalProfile {displayName}}
  | T.length displayName <= 16 = displayName
  | otherwise = T.take 16 displayName `T.snoc` '…'

splitFileDescr :: Int -> RcvFileDescrText -> NonEmpty FileDescr
splitFileDescr partSize rfdText = splitParts 1 rfdText
  where
    splitParts partNo remText =
      let (part, rest) = T.splitAt partSize remText
          complete = T.null rest
          fileDescr = FileDescr {fileDescrText = part, fileDescrPartNo = partNo, fileDescrComplete = complete}
       in if complete
            then fileDescr :| []
            else fileDescr <| splitParts (partNo + 1) rest

deleteGroupLink' :: User -> GroupInfo -> CM ()
deleteGroupLink' user gInfo = do
  vr <- chatVersionRange
  conn <- withStore $ \db -> getGroupLinkConnection db vr user gInfo
  deleteGroupLink_ user gInfo conn

deleteGroupLinkIfExists :: User -> GroupInfo -> CM ()
deleteGroupLinkIfExists user gInfo = do
  vr <- chatVersionRange
  conn_ <- eitherToMaybe <$> withStore' (\db -> runExceptT $ getGroupLinkConnection db vr user gInfo)
  mapM_ (deleteGroupLink_ user gInfo) conn_

deleteGroupLink_ :: User -> GroupInfo -> Connection -> CM ()
deleteGroupLink_ user gInfo conn = do
  deleteAgentConnectionAsync $ aConnId conn
  withStore' $ \db -> deleteGroupLink db user gInfo

startProximateTimedItemThread :: User -> (ChatRef, ChatItemId) -> UTCTime -> CM ()
startProximateTimedItemThread user itemRef deleteAt = do
  interval <- asks (cleanupManagerInterval . config)
  ts <- liftIO getCurrentTime
  when (diffUTCTime deleteAt ts <= interval) $
    startTimedItemThread user itemRef deleteAt

startTimedItemThread :: User -> (ChatRef, ChatItemId) -> UTCTime -> CM ()
startTimedItemThread user itemRef deleteAt = do
  itemThreads <- asks timedItemThreads
  threadTVar_ <- atomically $ do
    exists <- TM.member itemRef itemThreads
    if not exists
      then do
        threadTVar <- newTVar Nothing
        TM.insert itemRef threadTVar itemThreads
        pure $ Just threadTVar
      else pure Nothing
  forM_ threadTVar_ $ \threadTVar -> do
    tId <- mkWeakThreadId =<< deleteTimedItem user itemRef deleteAt `forkFinally` const (atomically $ TM.delete itemRef itemThreads)
    atomically $ writeTVar threadTVar (Just tId)

deleteTimedItem :: User -> (ChatRef, ChatItemId) -> UTCTime -> CM ()
deleteTimedItem user (ChatRef cType chatId scope, itemId) deleteAt = do
  ts <- liftIO getCurrentTime
  liftIO $ threadDelay' $ diffToMicroseconds $ diffUTCTime deleteAt ts
  lift waitChatStartedAndActivated
  vr <- chatVersionRange
  case cType of
    CTDirect -> do
      (ct, ci) <- withStore $ \db -> (,) <$> getContact db vr user chatId <*> getDirectChatItem db user chatId itemId
      deletions <- deleteDirectCIs user ct [ci]
      toView $ CEvtChatItemsDeleted user deletions True True
    CTGroup -> do
      (gInfo, ci) <- withStore $ \db -> (,) <$> getGroupInfo db vr user chatId <*> getGroupChatItem db user chatId itemId
      deletedTs <- liftIO getCurrentTime
      chatScopeInfo <- mapM (getChatScopeInfo vr user) scope
      deletions <- deleteGroupCIs user gInfo chatScopeInfo [ci] Nothing deletedTs
      toView $ CEvtChatItemsDeleted user deletions True True
    _ -> eToView $ ChatError $ CEInternalError "bad deleteTimedItem cType"

startUpdatedTimedItemThread :: User -> ChatRef -> ChatItem c d -> ChatItem c d -> CM ()
startUpdatedTimedItemThread user chatRef ci ci' =
  case (chatItemTimed ci >>= timedDeleteAt', chatItemTimed ci' >>= timedDeleteAt') of
    (Nothing, Just deleteAt') ->
      startProximateTimedItemThread user (chatRef, chatItemId' ci') deleteAt'
    _ -> pure ()

metaBrokerTs :: MsgMeta -> UTCTime
metaBrokerTs MsgMeta {broker = (_, brokerTs)} = brokerTs

createContactPQSndItem :: User -> Contact -> Connection -> PQEncryption -> CM (Contact, Connection)
createContactPQSndItem user ct conn@Connection {pqSndEnabled} pqSndEnabled' =
  flip catchAllErrors (const $ pure (ct, conn)) $ case (pqSndEnabled, pqSndEnabled') of
    (Just b, b') | b' /= b -> createPQItem $ CISndConnEvent (SCEPqEnabled pqSndEnabled')
    (Nothing, PQEncOn) -> createPQItem $ CISndDirectE2EEInfo (E2EInfo $ Just pqSndEnabled')
    _ -> pure (ct, conn)
  where
    createPQItem ciContent = do
      let conn' = conn {pqSndEnabled = Just pqSndEnabled'} :: Connection
          ct' = ct {activeConn = Just conn'} :: Contact
      when (contactPQEnabled ct /= contactPQEnabled ct') $ do
        createInternalChatItem user (CDDirectSnd ct') ciContent Nothing
        toView $ CEvtContactPQEnabled user ct' pqSndEnabled'
      pure (ct', conn')

updateContactPQRcv :: User -> Contact -> Connection -> PQEncryption -> CM (Contact, Connection)
updateContactPQRcv user ct conn@Connection {connId, pqRcvEnabled} pqRcvEnabled' =
  flip catchAllErrors (const $ pure (ct, conn)) $ case (pqRcvEnabled, pqRcvEnabled') of
    (Just b, b') | b' /= b -> updatePQ $ CIRcvConnEvent (RCEPqEnabled pqRcvEnabled')
    (Nothing, PQEncOn) -> updatePQ $ CIRcvDirectE2EEInfo (E2EInfo $ Just pqRcvEnabled')
    _ -> pure (ct, conn)
  where
    updatePQ ciContent = do
      withStore' $ \db -> updateConnPQRcvEnabled db connId pqRcvEnabled'
      let conn' = conn {pqRcvEnabled = Just pqRcvEnabled'} :: Connection
          ct' = ct {activeConn = Just conn'} :: Contact
      when (contactPQEnabled ct /= contactPQEnabled ct') $ do
        createInternalChatItem user (CDDirectRcv ct') ciContent Nothing
        toView $ CEvtContactPQEnabled user ct' pqRcvEnabled'
      pure (ct', conn')

updatePeerChatVRange :: Connection -> VersionRangeChat -> CM Connection
updatePeerChatVRange conn@Connection {connId, connChatVersion = v, peerChatVRange, connType, pqSupport, pqEncryption} msgVRange = do
  v' <- lift $ upgradedConnVersion v msgVRange
  conn' <-
    if msgVRange /= peerChatVRange || v' /= v
      then do
        withStore' $ \db -> setPeerChatVRange db connId v' msgVRange
        pure conn {connChatVersion = v', peerChatVRange = msgVRange}
      else pure conn
  -- TODO v6.0 remove/review: for contacts only version upgrade should trigger enabling PQ support/encryption
  if connType == ConnContact && v' >= pqEncryptionCompressionVersion && (pqSupport /= PQSupportOn || pqEncryption /= PQEncOn)
    then do
      withStore' $ \db -> updateConnSupportPQ db connId PQSupportOn PQEncOn
      pure conn' {pqSupport = PQSupportOn, pqEncryption = PQEncOn}
    else pure conn'

updateMemberChatVRange :: GroupMember -> Connection -> VersionRangeChat -> CM (GroupMember, Connection)
updateMemberChatVRange mem@GroupMember {groupMemberId, memberChatVRange} conn@Connection {connId, connChatVersion = v, peerChatVRange} msgVRange = do
  v' <- lift $ upgradedConnVersion v msgVRange
  if msgVRange /= peerChatVRange || v' /= v || msgVRange /= memberChatVRange
    then do
      withStore' $ \db -> do
        setPeerChatVRange db connId v' msgVRange
        setMemberChatVRange db groupMemberId msgVRange
      let conn' = conn {connChatVersion = v', peerChatVRange = msgVRange}
      pure (mem {memberChatVRange = msgVRange, activeConn = Just conn'}, conn')
    else pure (mem, conn)

upgradedConnVersion :: VersionChat -> VersionRangeChat -> CM' VersionChat
upgradedConnVersion v peerVR = do
  vr <- chatVersionRange'
  -- don't allow reducing agreed connection version
  pure $ maybe v (\(Compatible v') -> max v v') $ vr `compatibleVersion` peerVR

parseFileDescription :: FilePartyI p => Text -> CM (ValidFileDescription p)
parseFileDescription =
  liftEither . first (ChatError . CEInvalidFileDescription) . (strDecode . encodeUtf8)

sendDirectFileInline :: User -> Contact -> FileTransferMeta -> SharedMsgId -> CM ()
sendDirectFileInline user ct ft sharedMsgId = do
  msgDeliveryId <- sendFileInline_ ft sharedMsgId $ sendDirectContactMessage user ct
  withStore $ \db -> updateSndDirectFTDelivery db ct ft msgDeliveryId

sendMemberFileInline :: GroupMember -> Connection -> FileTransferMeta -> SharedMsgId -> CM ()
sendMemberFileInline m@GroupMember {groupId} conn ft sharedMsgId = do
  msgDeliveryId <- sendFileInline_ ft sharedMsgId $ \msg -> do
    (sndMsg, msgDeliveryId, _) <- sendDirectMemberMessage conn msg groupId
    pure (sndMsg, msgDeliveryId)
  withStore' $ \db -> updateSndGroupFTDelivery db m conn ft msgDeliveryId

sendFileInline_ :: FileTransferMeta -> SharedMsgId -> (ChatMsgEvent 'Binary -> CM (SndMessage, Int64)) -> CM Int64
sendFileInline_ FileTransferMeta {filePath, chunkSize} sharedMsgId sendMsg =
  sendChunks 1 =<< liftIO . B.readFile =<< lift (toFSFilePath filePath)
  where
    sendChunks chunkNo bytes = do
      let (chunk, rest) = B.splitAt chSize bytes
      (_, msgDeliveryId) <- sendMsg $ BFileChunk sharedMsgId $ FileChunk chunkNo chunk
      if B.null rest
        then pure msgDeliveryId
        else sendChunks (chunkNo + 1) rest
    chSize = fromIntegral chunkSize

parseChatMessage :: Connection -> ByteString -> CM (ChatMessage 'Json)
parseChatMessage conn s = do
  case parseChatMessages s of
    [msg] -> liftEither . first (ChatError . errType) $ (\(ACMsg _ m) -> checkEncoding m) =<< msg
    _ -> throwChatError $ CEException "parseChatMessage: single message is expected"
  where
    errType = CEInvalidChatMessage conn Nothing (safeDecodeUtf8 s)
{-# INLINE parseChatMessage #-}

getChatScopeInfo :: VersionRangeChat -> User -> GroupChatScope -> CM GroupChatScopeInfo
getChatScopeInfo vr user = \case
  GCSMemberSupport Nothing -> pure $ GCSIMemberSupport Nothing
  GCSMemberSupport (Just gmId) -> do
    supportMem <- withFastStore $ \db -> getGroupMemberById db vr user gmId
    pure $ GCSIMemberSupport (Just supportMem)

-- TODO [knocking] refactor to GroupChatScope -> "a" function, "a" is some new type? Or possibly split to get scope/get recipients steps
getGroupRecipients :: VersionRangeChat -> User -> GroupInfo -> Maybe GroupChatScope -> VersionChat -> CM (Maybe GroupChatScopeInfo, [GroupMember])
getGroupRecipients vr user gInfo@GroupInfo {membership} scope modsCompatVersion = case scope of
  Nothing -> do
    unless (memberCurrent membership && memberActive membership) $ throwChatError $ CECommandError "not current member"
    ms <- withFastStore' $ \db -> getGroupMembers db vr user gInfo
    let recipients = filter memberCurrent ms
    pure (Nothing, recipients)
  Just (GCSMemberSupport Nothing) -> do
    modMs <- withFastStore' $ \db -> getGroupModerators db vr user gInfo
    let rcpModMs' = filter (\m -> compatible m && memberCurrent m) modMs
    when (null rcpModMs') $ throwChatError $ CECommandError "no admins support this message"
    let scopeInfo = GCSIMemberSupport Nothing
    pure (Just scopeInfo, rcpModMs')
  Just (GCSMemberSupport (Just gmId)) -> do
    unless (memberCurrent membership && memberActive membership) $ throwChatError $ CECommandError "not current member"
    supportMem <- withFastStore $ \db -> getGroupMemberById db vr user gmId
    unless (memberCurrentOrPending supportMem) $ throwChatError $ CECommandError "support member not current or pending"
    let scopeInfo = GCSIMemberSupport (Just supportMem)
    if memberStatus supportMem == GSMemPendingApproval
      then pure (Just scopeInfo, [supportMem])
      else do
        modMs <- withFastStore' $ \db -> getGroupModerators db vr user gInfo
        let rcpModMs' = filter (\m -> compatible m && memberCurrent m) modMs
        pure (Just scopeInfo, [supportMem] <> rcpModMs')
  where
    compatible GroupMember {activeConn, memberChatVRange} =
      maxVersion (maybe memberChatVRange peerChatVRange activeConn) >= modsCompatVersion

mkLocalGroupChatScope :: GroupInfo -> CM (GroupInfo, Maybe GroupChatScopeInfo)
mkLocalGroupChatScope gInfo@GroupInfo {membership}
  | memberPending membership = do
      (gInfo', scopeInfo) <- mkGroupSupportChatInfo gInfo
      pure (gInfo', Just scopeInfo)
  | otherwise =
      pure (gInfo, Nothing)

mkGroupChatScope :: GroupInfo -> GroupMember -> CM (GroupInfo, GroupMember, Maybe GroupChatScopeInfo)
mkGroupChatScope gInfo@GroupInfo {membership} m
  | memberPending membership = do
      (gInfo', scopeInfo) <- mkGroupSupportChatInfo gInfo
      pure (gInfo', m, Just scopeInfo)
  | memberPending m = do
      (m', scopeInfo) <- mkMemberSupportChatInfo m
      pure (gInfo, m', Just scopeInfo)
  | otherwise =
      pure (gInfo, m, Nothing)

mkGetMessageChatScope :: VersionRangeChat -> User -> GroupInfo -> GroupMember -> Maybe MsgScope -> CM (GroupInfo, GroupMember, Maybe GroupChatScopeInfo)
mkGetMessageChatScope vr user gInfo@GroupInfo {membership} m msgScope_ =
  mkGroupChatScope gInfo m >>= \case
    groupScope@(_gInfo', _m', Just _scopeInfo) -> pure groupScope
    (_, _, Nothing) -> case msgScope_ of
      Nothing -> pure (gInfo, m, Nothing)
      Just (MSMember mId)
        | sameMemberId mId membership -> do
            (gInfo', scopeInfo) <- mkGroupSupportChatInfo gInfo
            pure (gInfo', m, Just scopeInfo)
        | otherwise -> do
            referredMember <- withStore $ \db -> getGroupMemberByMemberId db vr user gInfo mId
            -- TODO [knocking] return patched _referredMember' too?
            (_referredMember', scopeInfo) <- mkMemberSupportChatInfo referredMember
            pure (gInfo, m, Just scopeInfo)

mkGroupSupportChatInfo :: GroupInfo -> CM (GroupInfo, GroupChatScopeInfo)
mkGroupSupportChatInfo gInfo@GroupInfo {membership} =
  case supportChat membership of
    Nothing -> do
      chatTs <- liftIO getCurrentTime
      withStore' $ \db -> setSupportChatTs db (groupMemberId' membership) chatTs
      let gInfo' = gInfo {membership = membership {supportChat = Just $ GroupSupportChat chatTs 0 0 0 Nothing}}
          scopeInfo = GCSIMemberSupport {groupMember_ = Nothing}
      pure (gInfo', scopeInfo)
    Just _supportChat ->
      let scopeInfo = GCSIMemberSupport {groupMember_ = Nothing}
       in pure (gInfo, scopeInfo)

mkMemberSupportChatInfo :: GroupMember -> CM (GroupMember, GroupChatScopeInfo)
mkMemberSupportChatInfo m@GroupMember {groupMemberId, supportChat} =
  case supportChat of
    Nothing -> do
      chatTs <- liftIO getCurrentTime
      withStore' $ \db -> setSupportChatTs db groupMemberId chatTs
      let m' = m {supportChat = Just $ GroupSupportChat chatTs 0 0 0 Nothing}
          scopeInfo = GCSIMemberSupport {groupMember_ = Just m'}
      pure (m', scopeInfo)
    Just _supportChat ->
      let scopeInfo = GCSIMemberSupport {groupMember_ = Just m}
       in pure (m, scopeInfo)

sendFileChunk :: User -> SndFileTransfer -> CM ()
sendFileChunk user ft@SndFileTransfer {fileId, fileStatus, agentConnId = AgentConnId acId} =
  unless (fileStatus == FSComplete || fileStatus == FSCancelled) $ do
    vr <- chatVersionRange
    withStore' (`createSndFileChunk` ft) >>= \case
      Just chunkNo -> sendFileChunkNo ft chunkNo
      Nothing -> do
        ci <- withStore $ \db -> do
          liftIO $ updateSndFileStatus db ft FSComplete
          liftIO $ deleteSndFileChunks db ft
          updateDirectCIFileStatus db vr user fileId CIFSSndComplete
        toView $ CEvtSndFileComplete user ci ft
        lift $ closeFileHandle fileId sndFiles
        deleteAgentConnectionAsync acId

sendFileChunkNo :: SndFileTransfer -> Integer -> CM ()
sendFileChunkNo ft@SndFileTransfer {agentConnId = AgentConnId acId} chunkNo = do
  chunkBytes <- readFileChunk ft chunkNo
  (msgId, _) <- withAgent $ \a -> sendMessage a acId PQEncOff SMP.noMsgFlags $ smpEncode FileChunk {chunkNo, chunkBytes}
  withStore' $ \db -> updateSndFileChunkMsg db ft chunkNo msgId

readFileChunk :: SndFileTransfer -> Integer -> CM ByteString
readFileChunk SndFileTransfer {fileId, filePath, chunkSize} chunkNo = do
  fsFilePath <- lift $ toFSFilePath filePath
  read_ fsFilePath `catchThrow` (ChatError . CEFileRead filePath . show)
  where
    read_ fsFilePath = do
      h <- getFileHandle fileId fsFilePath sndFiles ReadMode
      pos <- hTell h
      let pos' = (chunkNo - 1) * chunkSize
      when (pos /= pos') $ hSeek h AbsoluteSeek pos'
      liftIO . B.hGet h $ fromInteger chunkSize

parseFileChunk :: ByteString -> CM FileChunk
parseFileChunk = liftEither . first (ChatError . CEFileRcvChunk) . smpDecode

appendFileChunk :: RcvFileTransfer -> Integer -> ByteString -> Bool -> CM ()
appendFileChunk ft@RcvFileTransfer {fileId, fileStatus, cryptoArgs, fileInvitation = FileInvitation {fileName}} chunkNo chunk final =
  case fileStatus of
    RFSConnected RcvFileInfo {filePath} -> append_ filePath
    -- sometimes update of file transfer status to FSConnected
    -- doesn't complete in time before MSG with first file chunk
    RFSAccepted RcvFileInfo {filePath} -> append_ filePath
    RFSCancelled _ -> pure ()
    _ -> throwChatError $ CEFileInternal "receiving file transfer not in progress"
  where
    append_ :: FilePath -> CM ()
    append_ filePath = do
      fsFilePath <- lift $ toFSFilePath filePath
      h <- getFileHandle fileId fsFilePath rcvFiles AppendMode
      liftIO (B.hPut h chunk >> hFlush h) `catchThrow` (fileErr . show)
      withStore' $ \db -> updatedRcvFileChunkStored db ft chunkNo
      when final $ do
        lift $ closeFileHandle fileId rcvFiles
        forM_ cryptoArgs $ \cfArgs -> do
          tmpFile <- lift getChatTempDirectory >>= liftIO . (`uniqueCombine` fileName)
          tryAllErrors (liftError encryptErr $ encryptFile fsFilePath tmpFile cfArgs) >>= \case
            Right () -> do
              removeFile fsFilePath `catchAllErrors` \_ -> pure ()
              renameFile tmpFile fsFilePath
            Left e -> do
              eToView e
              removeFile tmpFile `catchAllErrors` \_ -> pure ()
              withStore' (`removeFileCryptoArgs` fileId)
      where
        encryptErr e = fileErr $ e <> ", received file not encrypted"
        fileErr = ChatError . CEFileWrite filePath

getFileHandle :: Int64 -> FilePath -> (ChatController -> TVar (Map Int64 Handle)) -> IOMode -> CM Handle
getFileHandle fileId filePath files ioMode = do
  fs <- asks files
  h_ <- M.lookup fileId <$> readTVarIO fs
  maybe (newHandle fs) pure h_
  where
    newHandle fs = do
      h <- openFile filePath ioMode `catchThrow` (ChatError . CEFileInternal . show)
      atomically . modifyTVar fs $ M.insert fileId h
      pure h

isFileActive :: Int64 -> (ChatController -> TVar (Map Int64 Handle)) -> CM Bool
isFileActive fileId files = do
  fs <- asks files
  isJust . M.lookup fileId <$> readTVarIO fs

cancelRcvFileTransfer :: User -> RcvFileTransfer -> CM (Maybe ConnId)
cancelRcvFileTransfer user ft@RcvFileTransfer {fileId, xftpRcvFile, rcvFileInline} =
  cancel' `catchAllErrors` (\e -> eToView e $> fileConnId)
  where
    cancel' = do
      lift $ closeFileHandle fileId rcvFiles
      withStore' $ \db -> do
        updateFileCancelled db user fileId CIFSRcvCancelled
        updateRcvFileStatus db fileId FSCancelled
        deleteRcvFileChunks db ft
      case xftpRcvFile of
        Just XFTPRcvFile {agentRcvFileId = Just (AgentRcvFileId aFileId), agentRcvFileDeleted} ->
          unless agentRcvFileDeleted $ agentXFTPDeleteRcvFile aFileId fileId
        _ -> pure ()
      pure fileConnId
    fileConnId = if isNothing xftpRcvFile && isNothing rcvFileInline then liveRcvFileTransferConnId ft else Nothing

cancelSndFile :: User -> FileTransferMeta -> [SndFileTransfer] -> Bool -> CM [ConnId]
cancelSndFile user FileTransferMeta {fileId, xftpSndFile} fts sendCancel = do
  withStore' (\db -> updateFileCancelled db user fileId CIFSSndCancelled)
    `catchAllErrors` eToView
  case xftpSndFile of
    Nothing ->
      catMaybes <$> forM fts (\ft -> cancelSndFileTransfer user ft sendCancel)
    Just xsf -> do
      forM_ fts (\ft -> cancelSndFileTransfer user ft False)
      lift (agentXFTPDeleteSndFileRemote user xsf fileId) `catchAllErrors` eToView
      pure []

-- TODO v6.0 remove
cancelSndFileTransfer :: User -> SndFileTransfer -> Bool -> CM (Maybe ConnId)
cancelSndFileTransfer user@User {userId} ft@SndFileTransfer {fileId, connId, agentConnId = AgentConnId acId, fileStatus, fileInline} sendCancel =
  if fileStatus == FSCancelled || fileStatus == FSComplete
    then pure Nothing
    else cancel' `catchAllErrors` (\e -> eToView e $> fileConnId)
  where
    cancel' = do
      withStore' $ \db -> do
        updateSndFileStatus db ft FSCancelled
        deleteSndFileChunks db ft
      when sendCancel $ case fileInline of
        Just _ -> do
          vr <- chatVersionRange
          (sharedMsgId, conn) <- withStore $ \db -> (,) <$> getSharedMsgIdByFileId db userId fileId <*> getConnectionById db vr user connId
          void $ sendDirectMessage_ conn (BFileChunk sharedMsgId FileChunkCancel) (ConnectionId connId)
        _ -> withAgent $ \a -> void . sendMessage a acId PQEncOff SMP.noMsgFlags $ smpEncode FileChunkCancel
      pure fileConnId
    fileConnId = if isNothing fileInline then Just acId else Nothing

closeFileHandle :: Int64 -> (ChatController -> TVar (Map Int64 Handle)) -> CM' ()
closeFileHandle fileId files = do
  fs <- asks files
  h_ <- atomically . stateTVar fs $ \m -> (M.lookup fileId m, M.delete fileId m)
  liftIO $ mapM_ hClose h_ `catchAll_` pure ()

deleteMembersConnections :: User -> [GroupMember] -> CM ()
deleteMembersConnections user members = deleteMembersConnections' user members False

deleteMembersConnections' :: User -> [GroupMember] -> Bool -> CM ()
deleteMembersConnections' user members waitDelivery = do
  let memberConns = mapMaybe (\GroupMember {activeConn} -> activeConn) members
  deleteAgentConnectionsAsync' (map aConnId memberConns) waitDelivery
  lift . void . withStoreBatch' $ \db -> map (\Connection {connId} -> deleteConnectionRecord db user connId) memberConns

deleteMemberConnection :: GroupMember -> CM ()
deleteMemberConnection mem = deleteMemberConnection' mem False

deleteMemberConnection' :: GroupMember -> Bool -> CM ()
deleteMemberConnection' GroupMember {activeConn} waitDelivery = do
  forM_ activeConn $ \conn -> do
    deleteAgentConnectionAsync' (aConnId conn) waitDelivery
    withStore' $ \db -> updateConnectionStatus db conn ConnDeleted

deleteOrUpdateMemberRecord :: User -> GroupInfo -> GroupMember -> CM GroupInfo
deleteOrUpdateMemberRecord user gInfo member =
  withStore' $ \db -> deleteOrUpdateMemberRecordIO db user gInfo member

deleteOrUpdateMemberRecordIO :: DB.Connection -> User -> GroupInfo -> GroupMember -> IO GroupInfo
deleteOrUpdateMemberRecordIO db user@User {userId} gInfo member = do
  gInfo' <-
    if gmRequiresAttention member
      then decreaseGroupMembersRequireAttention db user gInfo
      else pure gInfo
  checkGroupMemberHasItems db user member >>= \case
    Just _ -> updateGroupMemberStatus db userId member GSMemRemoved
    Nothing -> deleteGroupMember db user member
  pure gInfo'

sendDirectContactMessages :: MsgEncodingI e => User -> Contact -> NonEmpty (ChatMsgEvent e) -> CM [Either ChatError SndMessage]
sendDirectContactMessages user ct events = do
  Connection {connChatVersion = v} <- liftEither $ contactSendConn_ ct
  if v >= batchSend2Version
    then sendDirectContactMessages' user ct events
    else forM (L.toList events) $ \evt ->
      (Right . fst <$> sendDirectContactMessage user ct evt) `catchAllErrors` \e -> pure (Left e)

sendDirectContactMessages' :: MsgEncodingI e => User -> Contact -> NonEmpty (ChatMsgEvent e) -> CM [Either ChatError SndMessage]
sendDirectContactMessages' user ct events = do
  conn@Connection {connId} <- liftEither $ contactSendConn_ ct
  let idsEvts = L.map (ConnectionId connId,) events
      msgFlags = MsgFlags {notification = any (hasNotification . toCMEventTag) events}
  sndMsgs_ <- lift $ createSndMessages idsEvts
  (sndMsgs', pqEnc_) <- batchSendConnMessagesB user conn msgFlags sndMsgs_
  forM_ pqEnc_ $ \pqEnc' -> void $ createContactPQSndItem user ct conn pqEnc'
  pure sndMsgs'

sendDirectContactMessage :: MsgEncodingI e => User -> Contact -> ChatMsgEvent e -> CM (SndMessage, Int64)
sendDirectContactMessage user ct chatMsgEvent = do
  conn@Connection {connId} <- liftEither $ contactSendConn_ ct
  r <- sendDirectMessage_ conn chatMsgEvent (ConnectionId connId)
  let (sndMessage, msgDeliveryId, pqEnc') = r
  void $ createContactPQSndItem user ct conn pqEnc'
  pure (sndMessage, msgDeliveryId)

contactSendConn_ :: Contact -> Either ChatError Connection
contactSendConn_ ct@Contact {activeConn} = case activeConn of
  Nothing -> err $ CEContactNotReady ct
  Just conn
    | not (connReady conn) -> err $ CEContactNotReady ct
    | not (contactActive ct) -> err $ CEContactNotActive ct
    | connDisabled conn -> err $ CEContactDisabled ct
    | otherwise -> Right conn
  where
    err = Left . ChatError

-- unlike sendGroupMemberMessage, this function will not store message as pending
-- TODO v5.8 we could remove pending messages once all clients support forwarding
sendDirectMemberMessage :: MsgEncodingI e => Connection -> ChatMsgEvent e -> GroupId -> CM (SndMessage, Int64, PQEncryption)
sendDirectMemberMessage conn chatMsgEvent groupId = sendDirectMessage_ conn chatMsgEvent (GroupId groupId)

sendDirectMessage_ :: MsgEncodingI e => Connection -> ChatMsgEvent e -> ConnOrGroupId -> CM (SndMessage, Int64, PQEncryption)
sendDirectMessage_ conn chatMsgEvent connOrGroupId = do
  when (connDisabled conn) $ throwChatError (CEConnectionDisabled conn)
  msg@SndMessage {msgId, msgBody} <- createSndMessage chatMsgEvent connOrGroupId
  -- TODO move compressed body to SndMessage and compress in createSndMessage
  (msgDeliveryId, pqEnc') <- deliverMessage conn (toCMEventTag chatMsgEvent) msgBody msgId
  pure (msg, msgDeliveryId, pqEnc')

createSndMessage :: MsgEncodingI e => ChatMsgEvent e -> ConnOrGroupId -> CM SndMessage
createSndMessage chatMsgEvent connOrGroupId =
  liftEither . runIdentity =<< lift (createSndMessages $ Identity (connOrGroupId, chatMsgEvent))

createSndMessages :: forall e t. (MsgEncodingI e, Traversable t) => t (ConnOrGroupId, ChatMsgEvent e) -> CM' (t (Either ChatError SndMessage))
createSndMessages idsEvents = do
  g <- asks random
  vr <- chatVersionRange'
  withStoreBatch $ \db -> fmap (createMsg db g vr) idsEvents
  where
    createMsg :: DB.Connection -> TVar ChaChaDRG -> VersionRangeChat -> (ConnOrGroupId, ChatMsgEvent e) -> IO (Either ChatError SndMessage)
    createMsg db g vr (connOrGroupId, evnt) = runExceptT $ do
      withExceptT ChatErrorStore $ createNewSndMessage db g connOrGroupId evnt encodeMessage
      where
        encodeMessage sharedMsgId =
          encodeChatMessage maxEncodedMsgLength ChatMessage {chatVRange = vr, msgId = Just sharedMsgId, chatMsgEvent = evnt}

sendGroupMemberMessages :: forall e. MsgEncodingI e => User -> Connection -> NonEmpty (ChatMsgEvent e) -> GroupId -> CM ()
sendGroupMemberMessages user conn events groupId = do
  when (connDisabled conn) $ throwChatError (CEConnectionDisabled conn)
  let idsEvts = L.map (GroupId groupId,) events
  (errs, msgs) <- lift $ partitionEithers . L.toList <$> createSndMessages idsEvts
  unless (null errs) $ toView $ CEvtChatErrors errs
  forM_ (L.nonEmpty msgs) $ \msgs' ->
    batchSendConnMessages user conn MsgFlags {notification = True} msgs'

batchSendConnMessages :: User -> Connection -> MsgFlags -> NonEmpty SndMessage -> CM ([Either ChatError SndMessage], Maybe PQEncryption)
batchSendConnMessages user conn msgFlags msgs =
  batchSendConnMessagesB user conn msgFlags $ L.map Right msgs

batchSendConnMessagesB :: User -> Connection -> MsgFlags -> NonEmpty (Either ChatError SndMessage) -> CM ([Either ChatError SndMessage], Maybe PQEncryption)
batchSendConnMessagesB _user conn msgFlags msgs_ = do
  let batched_ = batchSndMessagesJSON msgs_
  case L.nonEmpty batched_ of
    Just batched' -> do
      let msgReqs = L.map (fmap msgBatchReq_) batched'
      delivered <- deliverMessagesB msgReqs
      let msgs' = concat $ L.zipWith flattenMsgs batched' delivered
          pqEnc = findLastPQEnc delivered
      when (length msgs' /= length msgs_) $ logError "batchSendConnMessagesB: msgs_ and msgs' length mismatch"
      pure (msgs', pqEnc)
    Nothing -> pure ([], Nothing)
  where
    msgBatchReq_ :: MsgBatch -> ChatMsgReq
    msgBatchReq_ (MsgBatch batchBody sndMsgs) =
      (conn, msgFlags, (vrValue batchBody, map (\SndMessage {msgId} -> msgId) sndMsgs))
    flattenMsgs :: Either ChatError MsgBatch -> Either ChatError ([Int64], PQEncryption) -> [Either ChatError SndMessage]
    flattenMsgs (Right (MsgBatch _ sndMsgs)) (Right _) = map Right sndMsgs
    flattenMsgs (Right (MsgBatch _ sndMsgs)) (Left ce) = replicate (length sndMsgs) (Left ce)
    flattenMsgs (Left ce) _ = [Left ce] -- restore original ChatError
    findLastPQEnc :: NonEmpty (Either ChatError ([Int64], PQEncryption)) -> Maybe PQEncryption
    findLastPQEnc = foldr' (\x acc -> case x of Right (_, pqEnc) -> Just pqEnc; Left _ -> acc) Nothing

batchSndMessagesJSON :: NonEmpty (Either ChatError SndMessage) -> [Either ChatError MsgBatch]
batchSndMessagesJSON = batchMessages maxEncodedMsgLength . L.toList

encodeConnInfo :: MsgEncodingI e => ChatMsgEvent e -> CM ByteString
encodeConnInfo chatMsgEvent = do
  vr <- chatVersionRange
  encodeConnInfoPQ PQSupportOff (maxVersion vr) chatMsgEvent

encodeConnInfoPQ :: MsgEncodingI e => PQSupport -> VersionChat -> ChatMsgEvent e -> CM ByteString
encodeConnInfoPQ pqSup v chatMsgEvent = do
  vr <- chatVersionRange
  let info = ChatMessage {chatVRange = vr, msgId = Nothing, chatMsgEvent}
  case encodeChatMessage maxEncodedInfoLength info of
    ECMEncoded connInfo -> case pqSup of
      PQSupportOn | v >= pqEncryptionCompressionVersion && B.length connInfo > maxCompressedInfoLength -> do
        let connInfo' = compressedBatchMsgBody_ connInfo
        when (B.length connInfo' > maxCompressedInfoLength) $ throwChatError $ CEException "large compressed info"
        pure connInfo'
      _ -> pure connInfo
    ECMLarge -> throwChatError $ CEException "large info"

deliverMessage :: Connection -> CMEventTag e -> MsgBody -> MessageId -> CM (Int64, PQEncryption)
deliverMessage conn cmEventTag msgBody msgId = do
  let msgFlags = MsgFlags {notification = hasNotification cmEventTag}
  deliverMessage' conn msgFlags msgBody msgId

deliverMessage' :: Connection -> MsgFlags -> MsgBody -> MessageId -> CM (Int64, PQEncryption)
deliverMessage' conn msgFlags msgBody msgId =
  deliverMessages ((conn, msgFlags, (vrValue msgBody, [msgId])) :| []) >>= \case
    r :| [] -> case r of
      Right ([deliveryId], pqEnc) -> pure (deliveryId, pqEnc)
      Right (deliveryIds, _) -> throwChatError $ CEInternalError $ "deliverMessage: expected 1 delivery id, got " <> show (length deliveryIds)
      Left e -> throwError e
    rs -> throwChatError $ CEInternalError $ "deliverMessage: expected 1 result, got " <> show (length rs)

-- [MessageId] - SndMessage ids inside MsgBatch, or single message id
type ChatMsgReq = (Connection, MsgFlags, (ValueOrRef MsgBody, [MessageId]))

deliverMessages :: NonEmpty ChatMsgReq -> CM (NonEmpty (Either ChatError ([Int64], PQEncryption)))
deliverMessages msgs = deliverMessagesB $ L.map Right msgs

deliverMessagesB :: NonEmpty (Either ChatError ChatMsgReq) -> CM (NonEmpty (Either ChatError ([Int64], PQEncryption)))
deliverMessagesB msgReqs = do
  msgReqs' <- if any connSupportsPQ msgReqs then liftIO compressBodies else pure msgReqs
  sent <- L.zipWith prepareBatch msgReqs' <$> withAgent (`sendMessagesB` snd (mapAccumL toAgent Nothing msgReqs'))
  lift . void $ withStoreBatch' $ \db -> map (updatePQSndEnabled db) (rights . L.toList $ sent)
  lift . withStoreBatch $ \db -> L.map (bindRight $ createDelivery db) sent
  where
    connSupportsPQ = \case
      Right (Connection {pqSupport = PQSupportOn, connChatVersion = v}, _, _) -> v >= pqEncryptionCompressionVersion
      _ -> False
    compressBodies =
      forME msgReqs $ \(conn, msgFlags, (mbr, msgIds)) -> runExceptT $ do
        mbr' <- case mbr of
          VRValue i msgBody | B.length msgBody > maxCompressedMsgLength -> do
            let msgBody' = compressedBatchMsgBody_ msgBody
            when (B.length msgBody' > maxCompressedMsgLength) $ throwError $ ChatError $ CEException "large compressed message"
            pure $ VRValue i msgBody'
          v -> pure v
        pure (conn, msgFlags, (mbr', msgIds))
    toAgent prev = \case
      Right (conn@Connection {connId, pqEncryption}, msgFlags, (mbr, _msgIds)) ->
        let cId = case prev of
              Just prevId | prevId == connId -> ""
              _ -> aConnId conn
         in (Just connId, Right (cId, pqEncryption, msgFlags, mbr))
      Left _ce -> (prev, Left (AP.INTERNAL "ChatError, skip")) -- as long as it is Left, the agent batchers should just step over it
    prepareBatch (Right req) (Right ar) = Right (req, ar)
    prepareBatch (Left ce) _ = Left ce -- restore original ChatError
    prepareBatch _ (Left ae) = Left $ ChatErrorAgent ae Nothing
    createDelivery :: DB.Connection -> (ChatMsgReq, (AgentMsgId, PQEncryption)) -> IO (Either ChatError ([Int64], PQEncryption))
    createDelivery db ((Connection {connId}, _, (_, msgIds)), (agentMsgId, pqEnc')) = do
      Right . (,pqEnc') <$> mapM (createSndMsgDelivery db (SndMsgDelivery {connId, agentMsgId})) msgIds
    updatePQSndEnabled :: DB.Connection -> (ChatMsgReq, (AgentMsgId, PQEncryption)) -> IO ()
    updatePQSndEnabled db ((Connection {connId, pqSndEnabled}, _, _), (_, pqSndEnabled')) =
      case (pqSndEnabled, pqSndEnabled') of
        (Just b, b') | b' /= b -> updatePQ
        (Nothing, PQEncOn) -> updatePQ
        _ -> pure ()
      where
        updatePQ = updateConnPQSndEnabled db connId pqSndEnabled'

sendGroupMessage :: MsgEncodingI e => User -> GroupInfo -> Maybe GroupChatScope -> [GroupMember] -> ChatMsgEvent e -> CM SndMessage
sendGroupMessage user gInfo gcScope members chatMsgEvent = do
  sendGroupMessages user gInfo gcScope members (chatMsgEvent :| []) >>= \case
    ((Right msg) :| [], _) -> pure msg
    _ -> throwChatError $ CEInternalError "sendGroupMessage: expected 1 message"

sendGroupMessage' :: MsgEncodingI e => User -> GroupInfo -> [GroupMember] -> ChatMsgEvent e -> CM SndMessage
sendGroupMessage' user gInfo members chatMsgEvent =
  sendGroupMessages_ user gInfo members (chatMsgEvent :| []) >>= \case
    ((Right msg) :| [], _) -> pure msg
    _ -> throwChatError $ CEInternalError "sendGroupMessage': expected 1 message"

sendGroupMessages :: MsgEncodingI e => User -> GroupInfo -> Maybe GroupChatScope -> [GroupMember] -> NonEmpty (ChatMsgEvent e) -> CM (NonEmpty (Either ChatError SndMessage), GroupSndResult)
sendGroupMessages user gInfo scope members events = do
  -- TODO [knocking] send current profile to pending member after approval?
  when shouldSendProfileUpdate $
    sendProfileUpdate `catchAllErrors` eToView
  sendGroupMessages_ user gInfo members events
  where
    User {profile = p, userMemberProfileUpdatedAt} = user
    GroupInfo {userMemberProfileSentAt} = gInfo
    shouldSendProfileUpdate
      | isJust scope = False -- why not sending profile updates to scopes?
      | incognitoMembership gInfo = False
      | otherwise =
          case (userMemberProfileSentAt, userMemberProfileUpdatedAt) of
            (Just lastSentTs, Just lastUpdateTs) -> lastSentTs < lastUpdateTs
            (Nothing, Just _) -> True
            _ -> False
    sendProfileUpdate = do
      let members' = filter (`supportsVersion` memberProfileUpdateVersion) members
          profileUpdateEvent = XInfo $ redactedMemberProfile $ fromLocalProfile p
      void $ sendGroupMessage' user gInfo members' profileUpdateEvent
      currentTs <- liftIO getCurrentTime
      withStore' $ \db -> updateUserMemberProfileSentAt db user gInfo currentTs

data GroupSndResult = GroupSndResult
  { sentTo :: [(GroupMemberId, Either ChatError [MessageId], Either ChatError ([Int64], PQEncryption))],
    pending :: [(GroupMemberId, Either ChatError MessageId, Either ChatError ())],
    forwarded :: [GroupMember]
  }

sendGroupMessages_ :: MsgEncodingI e => User -> GroupInfo -> [GroupMember] -> NonEmpty (ChatMsgEvent e) -> CM (NonEmpty (Either ChatError SndMessage), GroupSndResult)
sendGroupMessages_ _user gInfo@GroupInfo {groupId} recipientMembers events = do
  let idsEvts = L.map (GroupId groupId,) events
  sndMsgs_ <- lift $ createSndMessages idsEvts
  recipientMembers' <- liftIO $ shuffleMembers recipientMembers
  let msgFlags = MsgFlags {notification = any (hasNotification . toCMEventTag) events}
      (toSendSeparate, toSendBatched, toPending, forwarded, _, dups) =
        foldr' (addMember recipientMembers') ([], [], [], [], S.empty, 0 :: Int) recipientMembers'
  when (dups /= 0) $ logError $ "sendGroupMessages_: " <> tshow dups <> " duplicate members"
  -- TODO PQ either somehow ensure that group members connections cannot have pqSupport/pqEncryption or pass Off's here
  -- Deliver to toSend members
  let (sendToMemIds, msgReqs) = prepareMsgReqs msgFlags sndMsgs_ toSendSeparate toSendBatched
  delivered <- maybe (pure []) (fmap L.toList . deliverMessagesB) $ L.nonEmpty msgReqs
  when (length delivered /= length sendToMemIds) $ logError "sendGroupMessages_: sendToMemIds and delivered length mismatch"
  -- Save as pending for toPending members
  let (pendingMemIds, pendingReqs) = preparePending sndMsgs_ toPending
  stored <- lift $ withStoreBatch (\db -> map (bindRight $ createPendingMsg db) pendingReqs)
  when (length stored /= length pendingMemIds) $ logError "sendGroupMessages_: pendingMemIds and stored length mismatch"
  -- Zip for easier access to results
  let sentTo = zipWith3 (\mId mReq r -> (mId, fmap (\(_, _, (_, msgIds)) -> msgIds) mReq, r)) sendToMemIds msgReqs delivered
      pending = zipWith3 (\mId pReq r -> (mId, fmap snd pReq, r)) pendingMemIds pendingReqs stored
  pure (sndMsgs_, GroupSndResult {sentTo, pending, forwarded})
  where
    shuffleMembers :: [GroupMember] -> IO [GroupMember]
    shuffleMembers ms = do
      let (adminMs, otherMs) = partition isAdmin ms
      liftM2 (<>) (shuffle adminMs) (shuffle otherMs)
      where
        isAdmin GroupMember {memberRole} = memberRole >= GRAdmin
    addMember members m acc@(toSendSeparate, toSendBatched, pending, forwarded, !mIds, !dups) =
      case memberSendAction gInfo events members m of
        Just a
          | mId `S.member` mIds -> (toSendSeparate, toSendBatched, pending, forwarded, mIds, dups + 1)
          | otherwise -> case a of
              MSASend conn -> ((m, conn) : toSendSeparate, toSendBatched, pending, forwarded, mIds', dups)
              MSASendBatched conn -> (toSendSeparate, (m, conn) : toSendBatched, pending, forwarded, mIds', dups)
              MSAPending -> (toSendSeparate, toSendBatched, m : pending, forwarded, mIds', dups)
              MSAForwarded -> (toSendSeparate, toSendBatched, pending, m : forwarded, mIds', dups)
        Nothing -> acc
      where
        mId = groupMemberId' m
        mIds' = S.insert mId mIds
    prepareMsgReqs :: MsgFlags -> NonEmpty (Either ChatError SndMessage) -> [(GroupMember, Connection)] -> [(GroupMember, Connection)] -> ([GroupMemberId], [Either ChatError ChatMsgReq])
    prepareMsgReqs msgFlags msgs toSendSeparate toSendBatched = do
      let batched_ = batchSndMessagesJSON msgs
      case L.nonEmpty batched_ of
        Just batched' -> do
          let lenMsgs = length msgs
              (memsSep, mreqsSep) = foldMembers lenMsgs sndMessageMBR msgs toSendSeparate
              (memsBtch, mreqsBtch) = foldMembers (length batched' + lenMsgs) msgBatchMBR batched' toSendBatched
          (memsSep <> memsBtch, mreqsSep <> mreqsBtch)
        Nothing -> ([], [])
      where
        foldMembers :: forall a. Int -> (Maybe Int -> Int -> a -> (ValueOrRef MsgBody, [MessageId])) -> NonEmpty (Either ChatError a) -> [(GroupMember, Connection)] -> ([GroupMemberId], [Either ChatError ChatMsgReq])
        foldMembers lastRef mkMb mbs mems = snd $ foldr' foldMsgBodies (lastMemIdx_, ([], [])) mems
          where
            lastMemIdx_ = let len = length mems in if len > 1 then Just len else Nothing
            foldMsgBodies :: (GroupMember, Connection) -> (Maybe Int, ([GroupMemberId], [Either ChatError ChatMsgReq])) -> (Maybe Int, ([GroupMemberId], [Either ChatError ChatMsgReq]))
            foldMsgBodies (GroupMember {groupMemberId}, conn) (memIdx_, memIdsReqs) =
              (subtract 1 <$> memIdx_,) $ snd $ foldr' addBody (lastRef, memIdsReqs) mbs
              where
                addBody :: Either ChatError a -> (Int, ([GroupMemberId], [Either ChatError ChatMsgReq])) -> (Int, ([GroupMemberId], [Either ChatError ChatMsgReq]))
                addBody mb (i, (memIds, reqs)) =
                  let req = (conn,msgFlags,) . mkMb memIdx_ i <$> mb
                   in (i - 1, (groupMemberId : memIds, req : reqs))
        sndMessageMBR :: Maybe Int -> Int -> SndMessage -> (ValueOrRef MsgBody, [MessageId])
        sndMessageMBR memIdx_ i SndMessage {msgId, msgBody} = (vrValue_ memIdx_ i msgBody, [msgId])
        msgBatchMBR :: Maybe Int -> Int -> MsgBatch -> (ValueOrRef MsgBody, [MessageId])
        msgBatchMBR memIdx_ i (MsgBatch batchBody sndMsgs) = (vrValue_ memIdx_ i batchBody, map (\SndMessage {msgId} -> msgId) sndMsgs)
        vrValue_ memIdx_ i v = case memIdx_ of
          Nothing -> VRValue Nothing v -- sending to one member, do not reference bodies
          Just 1 -> VRValue (Just i) v
          Just _ -> VRRef i
    preparePending :: NonEmpty (Either ChatError SndMessage) -> [GroupMember] -> ([GroupMemberId], [Either ChatError (GroupMemberId, MessageId)])
    preparePending msgs_ =
      foldr' foldMsgs ([], [])
      where
        foldMsgs :: GroupMember -> ([GroupMemberId], [Either ChatError (GroupMemberId, MessageId)]) -> ([GroupMemberId], [Either ChatError (GroupMemberId, MessageId)])
        foldMsgs GroupMember {groupMemberId} memIdsReqs =
          foldr' (\msg_ (memIds, reqs) -> (groupMemberId : memIds, fmap pendingReq msg_ : reqs)) memIdsReqs msgs_
          where
            pendingReq :: SndMessage -> (GroupMemberId, MessageId)
            pendingReq SndMessage {msgId} = (groupMemberId, msgId)
    createPendingMsg :: DB.Connection -> (GroupMemberId, MessageId) -> IO (Either ChatError ())
    createPendingMsg db (groupMemberId, msgId) =
      createPendingGroupMessage db groupMemberId msgId Nothing $> Right ()

data MemberSendAction = MSASend Connection | MSASendBatched Connection | MSAPending | MSAForwarded

memberSendAction :: GroupInfo -> NonEmpty (ChatMsgEvent e) -> [GroupMember] -> GroupMember -> Maybe MemberSendAction
memberSendAction gInfo events members m@GroupMember {memberRole, memberStatus} = case memberConn m of
  Nothing -> pendingOrForwarded
  Just conn@Connection {connStatus}
    | connDisabled conn || connStatus == ConnDeleted || memberStatus == GSMemRejected -> Nothing
    | connInactive conn -> Just MSAPending
    | connStatus == ConnSndReady || connStatus == ConnReady -> sendBatchedOrSeparate conn
    | otherwise -> pendingOrForwarded
  where
    sendBatchedOrSeparate conn
      -- admin doesn't support batch forwarding - send messages separately so that admin can forward one by one
      | memberRole >= GRAdmin && not (m `supportsVersion` batchSend2Version) = Just (MSASend conn)
      -- either member is not admin, or admin supports batched forwarding
      | otherwise = Just (MSASendBatched conn)
    pendingOrForwarded = case memberCategory m of
      GCUserMember -> Nothing -- shouldn't happen
      GCInviteeMember -> Just MSAPending
      GCHostMember -> Just MSAPending
      GCPreMember -> forwardSupportedOrPending (invitedByGroupMemberId $ membership gInfo)
      GCPostMember -> forwardSupportedOrPending (invitedByGroupMemberId m)
      where
        forwardSupportedOrPending invitingMemberId_
          | membersSupport && all isForwardedGroupMsg events = Just MSAForwarded
          | any isXGrpMsgForward events = Nothing
          | otherwise = Just MSAPending
          where
            membersSupport =
              m `supportsVersion` groupForwardVersion && invitingMemberSupportsForward
            invitingMemberSupportsForward = case invitingMemberId_ of
              Just invMemberId ->
                -- can be optimized for large groups by replacing [GroupMember] with Map GroupMemberId GroupMember
                case find (\m' -> groupMemberId' m' == invMemberId) members of
                  Just invitingMember -> invitingMember `supportsVersion` groupForwardVersion
                  Nothing -> False
              Nothing -> False
            isXGrpMsgForward event = case event of
              XGrpMsgForward {} -> True
              _ -> False

sendGroupMemberMessage :: MsgEncodingI e => GroupInfo -> GroupMember -> ChatMsgEvent e -> Maybe Int64 -> CM () -> CM ()
sendGroupMemberMessage gInfo@GroupInfo {groupId} m@GroupMember {groupMemberId} chatMsgEvent introId_ postDeliver = do
  msg <- createSndMessage chatMsgEvent (GroupId groupId)
  messageMember msg `catchAllErrors` eToView
  where
    messageMember :: SndMessage -> CM ()
    messageMember SndMessage {msgId, msgBody} = forM_ (memberSendAction gInfo (chatMsgEvent :| []) [m] m) $ \case
      MSASend conn -> deliverMessage conn (toCMEventTag chatMsgEvent) msgBody msgId >> postDeliver
      MSASendBatched conn -> deliverMessage conn (toCMEventTag chatMsgEvent) msgBody msgId >> postDeliver
      MSAPending -> withStore' $ \db -> createPendingGroupMessage db groupMemberId msgId introId_
      MSAForwarded -> pure ()

-- TODO ensure order - pending messages interleave with user input messages
sendPendingGroupMessages :: User -> GroupMember -> Connection -> CM ()
sendPendingGroupMessages user GroupMember {groupMemberId} conn = do
  pgms <- withStore' $ \db -> getPendingGroupMessages db groupMemberId
  forM_ (L.nonEmpty pgms) $ \pgms' -> do
    let msgs = L.map (\(sndMsg, _, _) -> sndMsg) pgms'
    void $ batchSendConnMessages user conn MsgFlags {notification = True} msgs
    lift . void . withStoreBatch' $ \db -> L.map (\SndMessage {msgId} -> deletePendingGroupMessage db groupMemberId msgId) msgs
    lift . void . withStoreBatch' $ \db -> L.map (\(_, tag, introId_) -> updateIntro_ db tag introId_) pgms'
  where
    updateIntro_ :: DB.Connection -> ACMEventTag -> Maybe Int64 -> IO ()
    updateIntro_ db tag introId_ = case (tag, introId_) of
      (ACMEventTag _ XGrpMemFwd_, Just introId) -> updateIntroStatus db introId GMIntroInvForwarded
      _ -> pure ()

saveDirectRcvMSG :: MsgEncodingI e => Connection -> MsgMeta -> MsgBody -> ChatMessage e -> CM (Connection, RcvMessage)
saveDirectRcvMSG conn@Connection {connId} agentMsgMeta msgBody ChatMessage {chatVRange, msgId = sharedMsgId_, chatMsgEvent} = do
  conn' <- updatePeerChatVRange conn chatVRange
  let agentMsgId = fst $ recipient agentMsgMeta
      newMsg = NewRcvMessage {chatMsgEvent, msgBody}
      rcvMsgDelivery = RcvMsgDelivery {connId, agentMsgId, agentMsgMeta}
  msg <- withStore $ \db -> createNewMessageAndRcvMsgDelivery db (ConnectionId connId) newMsg sharedMsgId_ rcvMsgDelivery Nothing
  pure (conn', msg)

saveGroupRcvMsg :: MsgEncodingI e => User -> GroupId -> GroupMember -> Connection -> MsgMeta -> MsgBody -> ChatMessage e -> CM (GroupMember, Connection, RcvMessage)
saveGroupRcvMsg user groupId authorMember conn@Connection {connId} agentMsgMeta msgBody ChatMessage {chatVRange, msgId = sharedMsgId_, chatMsgEvent} = do
  (am'@GroupMember {memberId = amMemId, groupMemberId = amGroupMemId}, conn') <- updateMemberChatVRange authorMember conn chatVRange
  let agentMsgId = fst $ recipient agentMsgMeta
      newMsg = NewRcvMessage {chatMsgEvent, msgBody}
      rcvMsgDelivery = RcvMsgDelivery {connId, agentMsgId, agentMsgMeta}
  msg <-
    withStore (\db -> createNewMessageAndRcvMsgDelivery db (GroupId groupId) newMsg sharedMsgId_ rcvMsgDelivery $ Just amGroupMemId)
      `catchAllErrors` \e -> case e of
        ChatErrorStore (SEDuplicateGroupMessage _ _ _ (Just forwardedByGroupMemberId)) -> do
          vr <- chatVersionRange
          fm <- withStore $ \db -> getGroupMember db vr user groupId forwardedByGroupMemberId
          forM_ (memberConn fm) $ \fmConn ->
            void $ sendDirectMemberMessage fmConn (XGrpMemCon amMemId) groupId
          throwError e
        _ -> throwError e
  pure (am', conn', msg)

saveGroupFwdRcvMsg :: MsgEncodingI e => User -> GroupId -> GroupMember -> GroupMember -> MsgBody -> ChatMessage e -> CM RcvMessage
saveGroupFwdRcvMsg user groupId forwardingMember refAuthorMember@GroupMember {memberId = refMemberId} msgBody ChatMessage {msgId = sharedMsgId_, chatMsgEvent} = do
  let newMsg = NewRcvMessage {chatMsgEvent, msgBody}
      fwdMemberId = Just $ groupMemberId' forwardingMember
      refAuthorId = Just $ groupMemberId' refAuthorMember
  withStore (\db -> createNewRcvMessage db (GroupId groupId) newMsg sharedMsgId_ refAuthorId fwdMemberId)
    `catchAllErrors` \e -> case e of
      ChatErrorStore (SEDuplicateGroupMessage _ _ (Just authorGroupMemberId) Nothing) -> do
        vr <- chatVersionRange
        am@GroupMember {memberId = amMemberId} <- withStore $ \db -> getGroupMember db vr user groupId authorGroupMemberId
        if sameMemberId refMemberId am
          then forM_ (memberConn forwardingMember) $ \fmConn ->
            void $ sendDirectMemberMessage fmConn (XGrpMemCon amMemberId) groupId
          else toView $ CEvtMessageError user "error" "saveGroupFwdRcvMsg: referenced author member id doesn't match message member id"
        throwError e
      _ -> throwError e

saveSndChatItem :: ChatTypeI c => User -> ChatDirection c 'MDSnd -> SndMessage -> CIContent 'MDSnd -> CM (ChatItem c 'MDSnd)
saveSndChatItem user cd msg content = saveSndChatItem' user cd msg content Nothing Nothing Nothing Nothing False

-- TODO [mentions] optimize by avoiding unnecesary parsing of control messages
saveSndChatItem' :: ChatTypeI c => User -> ChatDirection c 'MDSnd -> SndMessage -> CIContent 'MDSnd -> Maybe (CIFile 'MDSnd) -> Maybe (CIQuote c) -> Maybe CIForwardedFrom -> Maybe CITimed -> Bool -> CM (ChatItem c 'MDSnd)
saveSndChatItem' user cd msg content ciFile quotedItem itemForwarded itemTimed live = do
  let itemTexts = ciContentTexts content
  saveSndChatItems user cd [Right NewSndChatItemData {msg, content, itemTexts, itemMentions = M.empty, ciFile, quotedItem, itemForwarded}] itemTimed live >>= \case
    [Right ci] -> pure ci
    _ -> throwChatError $ CEInternalError "saveSndChatItem': expected 1 item"

data NewSndChatItemData c = NewSndChatItemData
  { msg :: SndMessage,
    content :: CIContent 'MDSnd,
    itemTexts :: (Text, Maybe MarkdownList),
    itemMentions :: Map MemberName CIMention,
    ciFile :: Maybe (CIFile 'MDSnd),
    quotedItem :: Maybe (CIQuote c),
    itemForwarded :: Maybe CIForwardedFrom
  }

saveSndChatItems ::
  forall c.
  ChatTypeI c =>
  User ->
  ChatDirection c 'MDSnd ->
  [Either ChatError (NewSndChatItemData c)] ->
  Maybe CITimed ->
  Bool ->
  CM [Either ChatError (ChatItem c 'MDSnd)]
saveSndChatItems user cd itemsData itemTimed live = do
  createdAt <- liftIO getCurrentTime
  vr <- chatVersionRange
  when (contactChatDeleted cd || any (\NewSndChatItemData {content} -> ciRequiresAttention content) (rights itemsData)) $
    void $ withStore' (\db -> updateChatTsStats db vr user cd createdAt Nothing)
  lift $ withStoreBatch (\db -> map (bindRight $ createItem db createdAt) itemsData)
  where
    createItem :: DB.Connection -> UTCTime -> NewSndChatItemData c -> IO (Either ChatError (ChatItem c 'MDSnd))
    createItem db createdAt NewSndChatItemData {msg = msg@SndMessage {sharedMsgId}, content, itemTexts, itemMentions, ciFile, quotedItem, itemForwarded} = do
      ciId <- createNewSndChatItem db user cd msg content quotedItem itemForwarded itemTimed live createdAt
      forM_ ciFile $ \CIFile {fileId} -> updateFileTransferChatItemId db fileId ciId createdAt
      let ci = mkChatItem_ cd False ciId content itemTexts ciFile quotedItem (Just sharedMsgId) itemForwarded itemTimed live False createdAt Nothing createdAt
      Right <$> case cd of
        CDGroupSnd g _scope | not (null itemMentions) -> createGroupCIMentions db g ci itemMentions
        _ -> pure ci

saveRcvChatItemNoParse :: (ChatTypeI c, ChatTypeQuotable c) => User -> ChatDirection c 'MDRcv -> RcvMessage -> UTCTime -> CIContent 'MDRcv -> CM (ChatItem c 'MDRcv, ChatInfo c)
saveRcvChatItemNoParse user cd msg brokerTs = saveRcvChatItem user cd msg brokerTs . ciContentNoParse

saveRcvChatItem :: (ChatTypeI c, ChatTypeQuotable c) => User -> ChatDirection c 'MDRcv -> RcvMessage -> UTCTime -> (CIContent 'MDRcv, (Text, Maybe MarkdownList)) -> CM (ChatItem c 'MDRcv, ChatInfo c)
saveRcvChatItem user cd msg@RcvMessage {sharedMsgId_} brokerTs content =
  saveRcvChatItem' user cd msg sharedMsgId_ brokerTs content Nothing Nothing False M.empty

ciContentNoParse :: CIContent 'MDRcv -> (CIContent 'MDRcv, (Text, Maybe MarkdownList))
ciContentNoParse content = (content, (ciContentToText content, Nothing))

saveRcvChatItem' :: (ChatTypeI c, ChatTypeQuotable c) => User -> ChatDirection c 'MDRcv -> RcvMessage -> Maybe SharedMsgId -> UTCTime -> (CIContent 'MDRcv, (Text, Maybe MarkdownList)) -> Maybe (CIFile 'MDRcv) -> Maybe CITimed -> Bool -> Map MemberName MsgMention -> CM (ChatItem c 'MDRcv, ChatInfo c)
saveRcvChatItem' user cd msg@RcvMessage {chatMsgEvent, forwardedByMember} sharedMsgId_ brokerTs (content, (t, ft_)) ciFile itemTimed live mentions = do
  createdAt <- liftIO getCurrentTime
  vr <- chatVersionRange
  withStore' $ \db -> do
    (mentions' :: Map MemberName CIMention, userMention) <- case cd of
      CDGroupRcv g@GroupInfo {membership} _scope _m -> do
        mentions' <- getRcvCIMentions db user g ft_ mentions
        let userReply = case cmToQuotedMsg chatMsgEvent of
              Just QuotedMsg {msgRef = MsgRef {memberId = Just mId}} -> sameMemberId mId membership
              _ -> False
            userMention' = userReply || any (\CIMention {memberId} -> sameMemberId memberId membership) mentions'
         in pure (mentions', userMention')
      CDDirectRcv _ -> pure (M.empty, False)
    cInfo' <- if (ciRequiresAttention content || contactChatDeleted cd)
      then updateChatTsStats db vr user cd createdAt (memberChatStats userMention)
      else pure $ toChatInfo cd
    (ciId, quotedItem, itemForwarded) <- createNewRcvChatItem db user cd msg sharedMsgId_ content itemTimed live userMention brokerTs createdAt
    forM_ ciFile $ \CIFile {fileId} -> updateFileTransferChatItemId db fileId ciId createdAt
    let ci = mkChatItem_ cd False ciId content (t, ft_) ciFile quotedItem sharedMsgId_ itemForwarded itemTimed live userMention brokerTs forwardedByMember createdAt
    ci' <- case cd of
      CDGroupRcv g _scope _m | not (null mentions') -> createGroupCIMentions db g ci mentions'
      _ -> pure ci
    pure (ci', cInfo')
  where
    memberChatStats :: Bool -> Maybe (Int, MemberAttention, Int)
    memberChatStats userMention = case cd of
      CDGroupRcv _g (Just scope) m -> do
        let unread = fromEnum $ ciCreateStatus content == CISRcvNew
         in Just (unread, memberAttentionChange unread (Just brokerTs) m scope, fromEnum userMention)
      _ -> Nothing

-- TODO [mentions] optimize by avoiding unnecessary parsing
mkChatItem :: (ChatTypeI c, MsgDirectionI d) => ChatDirection c d -> ShowGroupAsSender -> ChatItemId -> CIContent d -> Maybe (CIFile d) -> Maybe (CIQuote c) -> Maybe SharedMsgId -> Maybe CIForwardedFrom -> Maybe CITimed -> Bool -> Bool -> ChatItemTs -> Maybe GroupMemberId -> UTCTime -> ChatItem c d
mkChatItem cd showGroupAsSender ciId content file quotedItem sharedMsgId itemForwarded itemTimed live userMention itemTs forwardedByMember currentTs =
  let ts = ciContentTexts content
   in mkChatItem_ cd showGroupAsSender ciId content ts file quotedItem sharedMsgId itemForwarded itemTimed live userMention itemTs forwardedByMember currentTs

mkChatItem_ :: (ChatTypeI c, MsgDirectionI d) => ChatDirection c d -> ShowGroupAsSender -> ChatItemId -> CIContent d -> (Text, Maybe MarkdownList) -> Maybe (CIFile d) -> Maybe (CIQuote c) -> Maybe SharedMsgId -> Maybe CIForwardedFrom -> Maybe CITimed -> Bool -> Bool -> ChatItemTs -> Maybe GroupMemberId -> UTCTime -> ChatItem c d
mkChatItem_ cd showGroupAsSender ciId content (itemText, formattedText) file quotedItem sharedMsgId itemForwarded itemTimed live userMention itemTs forwardedByMember currentTs =
  let itemStatus = ciCreateStatus content
      meta = mkCIMeta ciId content itemText itemStatus Nothing sharedMsgId itemForwarded Nothing False itemTimed (justTrue live) userMention currentTs itemTs forwardedByMember showGroupAsSender currentTs currentTs
   in ChatItem {chatDir = toCIDirection cd, meta, content, mentions = M.empty, formattedText, quotedItem, reactions = [], file}

createAgentConnectionAsync :: ConnectionModeI c => User -> CommandFunction -> Bool -> SConnectionMode c -> SubscriptionMode -> CM (CommandId, ConnId)
createAgentConnectionAsync user cmdFunction enableNtfs cMode subMode = do
  cmdId <- withStore' $ \db -> createCommand db user Nothing cmdFunction
  connId <- withAgent $ \a -> createConnectionAsync a (aUserId user) (aCorrId cmdId) enableNtfs cMode IKPQOff subMode
  pure (cmdId, connId)

joinAgentConnectionAsync :: User -> Bool -> ConnectionRequestUri c -> ConnInfo -> SubscriptionMode -> CM (CommandId, ConnId)
joinAgentConnectionAsync user enableNtfs cReqUri cInfo subMode = do
  cmdId <- withStore' $ \db -> createCommand db user Nothing CFJoinConn
  connId <- withAgent $ \a -> joinConnectionAsync a (aUserId user) (aCorrId cmdId) enableNtfs cReqUri cInfo PQSupportOff subMode
  pure (cmdId, connId)

allowAgentConnectionAsync :: MsgEncodingI e => User -> Connection -> ConfirmationId -> ChatMsgEvent e -> CM ()
allowAgentConnectionAsync user conn@Connection {connId, pqSupport, connChatVersion} confId msg = do
  cmdId <- withStore' $ \db -> createCommand db user (Just connId) CFAllowConn
  dm <- encodeConnInfoPQ pqSupport connChatVersion msg
  withAgent $ \a -> allowConnectionAsync a (aCorrId cmdId) (aConnId conn) confId dm
  withStore' $ \db -> updateConnectionStatus db conn ConnAccepted

agentAcceptContactAsync :: MsgEncodingI e => User -> Bool -> InvitationId -> ChatMsgEvent e -> SubscriptionMode -> PQSupport -> VersionChat -> CM (CommandId, ConnId)
agentAcceptContactAsync user enableNtfs invId msg subMode pqSup chatV = do
  cmdId <- withStore' $ \db -> createCommand db user Nothing CFAcceptContact
  dm <- encodeConnInfoPQ pqSup chatV msg
  connId <- withAgent $ \a -> acceptContactAsync a (aUserId user) (aCorrId cmdId) enableNtfs invId dm pqSup subMode
  pure (cmdId, connId)

deleteAgentConnectionAsync :: ConnId -> CM ()
deleteAgentConnectionAsync acId = deleteAgentConnectionAsync' acId False
{-# INLINE deleteAgentConnectionAsync #-}

deleteAgentConnectionAsync' :: ConnId -> Bool -> CM ()
deleteAgentConnectionAsync' acId waitDelivery = do
  withAgent (\a -> deleteConnectionAsync a waitDelivery acId) `catchAllErrors` eToView

deleteAgentConnectionsAsync :: [ConnId] -> CM ()
deleteAgentConnectionsAsync acIds = deleteAgentConnectionsAsync' acIds False
{-# INLINE deleteAgentConnectionsAsync #-}

deleteAgentConnectionsAsync' :: [ConnId] -> Bool -> CM ()
deleteAgentConnectionsAsync' [] _ = pure ()
deleteAgentConnectionsAsync' acIds waitDelivery = do
  withAgent (\a -> deleteConnectionsAsync a waitDelivery acIds) `catchAllErrors` eToView

agentXFTPDeleteRcvFile :: RcvFileId -> FileTransferId -> CM ()
agentXFTPDeleteRcvFile aFileId fileId = do
  lift $ withAgent' (`xftpDeleteRcvFile` aFileId)
  withStore' $ \db -> setRcvFTAgentDeleted db fileId

agentXFTPDeleteRcvFiles :: [(XFTPRcvFile, FileTransferId)] -> CM' ()
agentXFTPDeleteRcvFiles rcvFiles = do
  let rcvFiles' = filter (not . agentRcvFileDeleted . fst) rcvFiles
      rfIds = mapMaybe fileIds rcvFiles'
  withAgent' $ \a -> xftpDeleteRcvFiles a (map fst rfIds)
  void . withStoreBatch' $ \db -> map (setRcvFTAgentDeleted db . snd) rfIds
  where
    fileIds :: (XFTPRcvFile, FileTransferId) -> Maybe (RcvFileId, FileTransferId)
    fileIds (XFTPRcvFile {agentRcvFileId = Just (AgentRcvFileId aFileId)}, fileId) = Just (aFileId, fileId)
    fileIds _ = Nothing

agentXFTPDeleteSndFileRemote :: User -> XFTPSndFile -> FileTransferId -> CM' ()
agentXFTPDeleteSndFileRemote user xsf fileId =
  agentXFTPDeleteSndFilesRemote user [(xsf, fileId)]

agentXFTPDeleteSndFilesRemote :: User -> [(XFTPSndFile, FileTransferId)] -> CM' ()
agentXFTPDeleteSndFilesRemote user sndFiles = do
  (_errs, redirects) <- partitionEithers <$> withStoreBatch' (\db -> map (lookupFileTransferRedirectMeta db user . snd) sndFiles)
  let redirects' = mapMaybe mapRedirectMeta $ concat redirects
      sndFilesAll = redirects' <> sndFiles
      sndFilesAll' = filter (not . agentSndFileDeleted . fst) sndFilesAll
  -- while file is being prepared and uploaded, it would not have description available;
  -- this partitions files into those with and without descriptions -
  -- files with description are deleted remotely, files without description are deleted internally
  (sfsNoDescr, sfsWithDescr) <- partitionSndDescr sndFilesAll' [] []
  withAgent' $ \a -> xftpDeleteSndFilesInternal a sfsNoDescr
  withAgent' $ \a -> xftpDeleteSndFilesRemote a (aUserId user) sfsWithDescr
  void . withStoreBatch' $ \db -> map (setSndFTAgentDeleted db user . snd) sndFilesAll'
  where
    mapRedirectMeta :: FileTransferMeta -> Maybe (XFTPSndFile, FileTransferId)
    mapRedirectMeta FileTransferMeta {fileId = fileId, xftpSndFile = Just sndFileRedirect} = Just (sndFileRedirect, fileId)
    mapRedirectMeta _ = Nothing
    partitionSndDescr ::
      [(XFTPSndFile, FileTransferId)] ->
      [SndFileId] ->
      [(SndFileId, ValidFileDescription 'FSender)] ->
      CM' ([SndFileId], [(SndFileId, ValidFileDescription 'FSender)])
    partitionSndDescr [] filesWithoutDescr filesWithDescr = pure (filesWithoutDescr, filesWithDescr)
    partitionSndDescr ((XFTPSndFile {agentSndFileId = AgentSndFileId aFileId, privateSndFileDescr}, _) : xsfs) filesWithoutDescr filesWithDescr =
      case privateSndFileDescr of
        Nothing -> partitionSndDescr xsfs (aFileId : filesWithoutDescr) filesWithDescr
        Just sfdText ->
          tryAllErrors' (parseFileDescription sfdText) >>= \case
            Left _ -> partitionSndDescr xsfs (aFileId : filesWithoutDescr) filesWithDescr
            Right sfd -> partitionSndDescr xsfs filesWithoutDescr ((aFileId, sfd) : filesWithDescr)

connRequestPQEncryption :: ConnectionRequestUri c -> Maybe PQEncryption
connRequestPQEncryption = \case
  CRContactUri _ -> Nothing
  CRInvitationUri _ (CR.E2ERatchetParamsUri vr' _ _ pq) ->
    Just $ PQEncryption $ maxVersion vr' >= CR.pqRatchetE2EEncryptVersion && isJust pq

createRcvFeatureItems :: User -> Contact -> Contact -> CM' ()
createRcvFeatureItems user ct ct' =
  createFeatureItems user ct ct' CDDirectRcv CIRcvChatFeature CIRcvChatPreference contactPreference

createSndFeatureItems :: User -> Contact -> Contact -> CM' ()
createSndFeatureItems user ct ct' =
  createFeatureItems user ct ct' CDDirectSnd CISndChatFeature CISndChatPreference getPref
  where
    getPref ContactUserPreference {userPreference} = case userPreference of
      CUPContact {preference} -> preference
      CUPUser {preference} -> preference

-- Used when contact is changed after creating initial feature items via createFeatureEnabledItems_
-- (APIChangePreparedContactUser, APIConnectPreparedContact with incognito = True);
-- creates feature items with CDDirectRcv direction so that changed feature items stay in the same place in chat view
createContactChangedFeatureItems :: User -> Contact -> Contact -> CM' ()
createContactChangedFeatureItems user ct ct' =
  createFeatureItems user ct ct' CDDirectRcv CIRcvChatFeature CIRcvChatPreference getPref
  where
    getPref ContactUserPreference {userPreference} = case userPreference of
      CUPContact {preference} -> preference
      CUPUser {preference} -> preference

type FeatureContent a d = ChatFeature -> a -> Maybe Int -> CIContent d

createFeatureEnabledItems :: User -> Contact -> CM ()
createFeatureEnabledItems user ct = createFeatureEnabledItems_ user ct >>= toView . CEvtNewChatItems user

createFeatureEnabledItems_ :: User -> Contact -> CM [AChatItem]
createFeatureEnabledItems_ user ct@Contact {mergedPreferences} =
  forM allChatFeatures $ \(ACF f) -> do
    let state = featureState $ getContactUserPreference f mergedPreferences
    createChatItem user (CDDirectRcv ct) False (uncurry (CIRcvChatFeature $ chatFeature f) state) Nothing Nothing

createFeatureItems ::
  MsgDirectionI d =>
  User ->
  Contact ->
  Contact ->
  (Contact -> ChatDirection 'CTDirect d) ->
  FeatureContent PrefEnabled d ->
  FeatureContent FeatureAllowed d ->
  (forall f. ContactUserPreference (FeaturePreference f) -> FeaturePreference f) ->
  CM' ()
createFeatureItems user ct ct' = createContactsFeatureItems user [(ct, ct')]

createContactsFeatureItems ::
  forall d.
  MsgDirectionI d =>
  User ->
  [(Contact, Contact)] ->
  (Contact -> ChatDirection 'CTDirect d) ->
  FeatureContent PrefEnabled d ->
  FeatureContent FeatureAllowed d ->
  (forall f. ContactUserPreference (FeaturePreference f) -> FeaturePreference f) ->
  CM' ()
createContactsFeatureItems user cts chatDir ciFeature ciOffer getPref = do
  let dirsCIContents = map contactChangedFeatures cts
  (errs, acis) <- partitionEithers <$> createChatItems user Nothing dirsCIContents
  unless (null errs) $ toView' $ CEvtChatErrors errs
  toView' $ CEvtNewChatItems user acis
  where
    contactChangedFeatures :: (Contact, Contact) -> (ChatDirection 'CTDirect d, ShowGroupAsSender, [(CIContent d, Maybe SharedMsgId)])
    contactChangedFeatures (Contact {mergedPreferences = cups}, ct'@Contact {mergedPreferences = cups'}) = do
      let contents = mapMaybe (\(ACF f) -> featureCIContent_ f) allChatFeatures
      (chatDir ct', False, contents)
      where
        featureCIContent_ :: forall f. FeatureI f => SChatFeature f -> Maybe (CIContent d, Maybe SharedMsgId)
        featureCIContent_ f
          | state /= state' = Just (fContent ciFeature state', Nothing)
          | prefState /= prefState' = Just (fContent ciOffer prefState', Nothing)
          | otherwise = Nothing
          where
            fContent :: FeatureContent a d -> (a, Maybe Int) -> CIContent d
            fContent ci (s, param) = ci f' s param
            f' = chatFeature f
            state = featureState cup
            state' = featureState cup'
            prefState = preferenceState $ getPref cup
            prefState' = preferenceState $ getPref cup'
            cup = getContactUserPreference f cups
            cup' = getContactUserPreference f cups'

createGroupFeatureChangedItems :: MsgDirectionI d => User -> ChatDirection 'CTGroup d -> (GroupFeature -> GroupPreference -> Maybe Int -> Maybe GroupMemberRole -> CIContent d) -> GroupInfo -> GroupInfo -> CM ()
createGroupFeatureChangedItems user cd ciContent GroupInfo {fullGroupPreferences = gps} GroupInfo {fullGroupPreferences = gps'} =
  forM_ allGroupFeatures $ \(AGF f) -> do
    let state = groupFeatureState $ getGroupPreference f gps
        pref' = getGroupPreference f gps'
        state'@(_, param', role') = groupFeatureState pref'
    when (state /= state') $
      createInternalChatItem user cd (ciContent (toGroupFeature f) (toGroupPreference pref') param' role') Nothing

sameGroupProfileInfo :: GroupProfile -> GroupProfile -> Bool
sameGroupProfileInfo p p' = p {groupPreferences = Nothing} == p' {groupPreferences = Nothing}

createGroupFeatureItems :: MsgDirectionI d => User -> ChatDirection 'CTGroup d -> (GroupFeature -> GroupPreference -> Maybe Int -> Maybe GroupMemberRole -> CIContent d) -> GroupInfo -> CM ()
createGroupFeatureItems user cd ciContent g = createGroupFeatureItems_ user cd False ciContent g >>= toView . CEvtNewChatItems user

createGroupFeatureItems_ :: MsgDirectionI d => User -> ChatDirection 'CTGroup d -> ShowGroupAsSender -> (GroupFeature -> GroupPreference -> Maybe Int -> Maybe GroupMemberRole -> CIContent d) -> GroupInfo -> CM [AChatItem]
createGroupFeatureItems_ user cd showGroupAsSender ciContent GroupInfo {fullGroupPreferences} =
  forM allGroupFeatures $ \(AGF f) -> do
    let p = getGroupPreference f fullGroupPreferences
        (_, param, role) = groupFeatureState p
    createChatItem user cd showGroupAsSender (ciContent (toGroupFeature f) (toGroupPreference p) param role) Nothing Nothing

createInternalChatItem :: (ChatTypeI c, MsgDirectionI d) => User -> ChatDirection c d -> CIContent d -> Maybe UTCTime -> CM ()
createInternalChatItem user cd content itemTs_ = do
  ci <- createChatItem user cd False content Nothing itemTs_
  toView $ CEvtNewChatItems user [ci]

createChatItem :: (ChatTypeI c, MsgDirectionI d) => User -> ChatDirection c d -> ShowGroupAsSender -> CIContent d -> Maybe SharedMsgId -> Maybe UTCTime -> CM AChatItem
createChatItem user cd showGroupAsSender content sharedMsgId itemTs_ =
  lift (createChatItems user itemTs_ [(cd, showGroupAsSender, [(content, sharedMsgId)])]) >>= \case
    [Right ci] -> pure ci
    [Left e] -> throwError e
    rs -> throwChatError $ CEInternalError $ "createInternalChatItem: expected 1 result, got " <> show (length rs)

-- Supports items with shared msg ID that are created for all conversation parties, but were not communicated via the usual messages.
-- This includes address welcome message and contact request message.
createChatItems ::
  forall c d.
  (ChatTypeI c, MsgDirectionI d) =>
  User ->
  Maybe UTCTime ->
  [(ChatDirection c d, ShowGroupAsSender, [(CIContent d, Maybe SharedMsgId)])] ->
  CM' [Either ChatError AChatItem]
createChatItems user itemTs_ dirsCIContents = do
  createdAt <- liftIO getCurrentTime
  let itemTs = fromMaybe createdAt itemTs_
  vr <- chatVersionRange'
  void . withStoreBatch' $ \db -> map (updateChat db vr createdAt) dirsCIContents
  withStoreBatch' $ \db -> concatMap (createACIs db itemTs createdAt) dirsCIContents
  where
    updateChat :: DB.Connection -> VersionRangeChat -> UTCTime -> (ChatDirection c d, ShowGroupAsSender, [(CIContent d, Maybe SharedMsgId)]) -> IO ()
    updateChat db vr createdAt (cd, _, contents)
      | any (ciRequiresAttention . fst) contents || contactChatDeleted cd = void $ updateChatTsStats db vr user cd createdAt memberChatStats
      | otherwise = pure ()
      where
        memberChatStats :: Maybe (Int, MemberAttention, Int)
        memberChatStats = case cd of
          CDGroupRcv _g (Just scope) m -> do
            let unread = length $ filter (ciRequiresAttention . fst) contents
             in Just (unread, memberAttentionChange unread itemTs_ m scope, 0)
          _ -> Nothing
    createACIs :: DB.Connection -> UTCTime -> UTCTime -> (ChatDirection c d, ShowGroupAsSender, [(CIContent d, Maybe SharedMsgId)]) -> [IO AChatItem]
    createACIs db itemTs createdAt (cd, showGroupAsSender, contents) = map createACI contents
      where
        createACI (content, sharedMsgId) = do
          ciId <- createNewChatItemNoMsg db user cd showGroupAsSender content sharedMsgId itemTs createdAt
          let ci = mkChatItem cd showGroupAsSender ciId content Nothing Nothing Nothing Nothing Nothing False False itemTs Nothing createdAt
          pure $ AChatItem (chatTypeI @c) (msgDirection @d) (toChatInfo cd) ci

memberAttentionChange :: Int -> (Maybe UTCTime) -> GroupMember -> GroupChatScopeInfo -> MemberAttention
memberAttentionChange unread brokerTs_ rcvMem = \case
  GCSIMemberSupport (Just suppMem)
    | groupMemberId' suppMem == groupMemberId' rcvMem -> MAInc unread brokerTs_
    | msgIsNewerThanLastUnanswered -> MAReset
    | otherwise -> MAInc 0 Nothing
    where
      msgIsNewerThanLastUnanswered = case (supportChat suppMem >>= lastMsgFromMemberTs, brokerTs_) of
        (Just lastMsgTs, Just brokerTs) -> lastMsgTs < brokerTs
        _ -> False
  GCSIMemberSupport Nothing -> MAInc 0 Nothing

createLocalChatItems ::
  User ->
  ChatDirection 'CTLocal 'MDSnd ->
  NonEmpty (CIContent 'MDSnd, Maybe (CIFile 'MDSnd), Maybe CIForwardedFrom, (Text, Maybe MarkdownList)) ->
  UTCTime ->
  CM [ChatItem 'CTLocal 'MDSnd]
createLocalChatItems user cd itemsData createdAt = do
  vr <- chatVersionRange
  void $ withStore' $ \db -> updateChatTsStats db vr user cd createdAt Nothing
  (errs, items) <- lift $ partitionEithers <$> withStoreBatch' (\db -> map (createItem db) $ L.toList itemsData)
  unless (null errs) $ toView $ CEvtChatErrors errs
  pure items
  where
    createItem :: DB.Connection -> (CIContent 'MDSnd, Maybe (CIFile 'MDSnd), Maybe CIForwardedFrom, (Text, Maybe MarkdownList)) -> IO (ChatItem 'CTLocal 'MDSnd)
    createItem db (content, ciFile, itemForwarded, ts) = do
      ciId <- createNewChatItem_ db user cd False Nothing Nothing content (Nothing, Nothing, Nothing, Nothing, Nothing) itemForwarded Nothing False False createdAt Nothing createdAt
      forM_ ciFile $ \CIFile {fileId} -> updateFileTransferChatItemId db fileId ciId createdAt
      pure $ mkChatItem_ cd False ciId content ts ciFile Nothing Nothing itemForwarded Nothing False False createdAt Nothing createdAt

withUser' :: (User -> CM ChatResponse) -> CM ChatResponse
withUser' action =
  asks currentUser
    >>= readTVarIO
    >>= maybe (throwChatError CENoActiveUser) action

withUser :: (User -> CM ChatResponse) -> CM ChatResponse
withUser action = withUser' $ \user ->
  ifM (lift chatStarted) (action user) (throwChatError CEChatNotStarted)

withUser_ :: CM ChatResponse -> CM ChatResponse
withUser_ = withUser . const

withUserId' :: UserId -> (User -> CM ChatResponse) -> CM ChatResponse
withUserId' userId action = withUser' $ \user -> do
  checkSameUser userId user
  action user

withUserId :: UserId -> (User -> CM ChatResponse) -> CM ChatResponse
withUserId userId action = withUser $ \user -> do
  checkSameUser userId user
  action user

checkSameUser :: UserId -> User -> CM ()
checkSameUser userId User {userId = activeUserId} = when (userId /= activeUserId) $ throwChatError (CEDifferentActiveUser userId activeUserId)

chatStarted :: CM' Bool
chatStarted = fmap isJust . readTVarIO =<< asks agentAsync

waitChatStartedAndActivated :: CM' ()
waitChatStartedAndActivated = do
  agentStarted <- asks agentAsync
  chatActivated <- asks chatActivated
  atomically $ do
    started <- readTVar agentStarted
    activated <- readTVar chatActivated
    unless (isJust started && activated) retry

chatVersionRange :: CM VersionRangeChat
chatVersionRange = lift chatVersionRange'
{-# INLINE chatVersionRange #-}

chatVersionRange' :: CM' VersionRangeChat
chatVersionRange' = do
  ChatConfig {chatVRange} <- asks config
  pure chatVRange
{-# INLINE chatVersionRange' #-}

adminContactReq :: ConnReqContact
adminContactReq =
  either error id $ strDecode "simplex:/contact#/?v=1&smp=smp%3A%2F%2FPQUV2eL0t7OStZOoAsPEV2QYWt4-xilbakvGUGOItUo%3D%40smp6.simplex.im%2FK1rslx-m5bpXVIdMZg9NLUZ_8JBm8xTt%23MCowBQYDK2VuAyEALDeVe-sG8mRY22LsXlPgiwTNs9dbiLrNuA7f3ZMAJ2w%3D"

simplexTeamContactProfile :: Profile
simplexTeamContactProfile =
  Profile
    { displayName = "Ask SimpleX Team",
      fullName = "",
      shortDescr = Just "Send questions about SimpleX Chat app and your suggestions",
      image = Just (ImageData ""),
      contactLink = Just $ CLFull adminContactReq,
      peerType = Nothing,
      preferences = Nothing
    }

simplexStatusContactProfile :: Profile
simplexStatusContactProfile =
  Profile
    { displayName = "SimpleX Status",
      fullName = "",
      shortDescr = Just "Automatic server status and app release updates",
      image = Just (ImageData ""),
      contactLink = Just (either error CLFull $ strDecode "simplex:/contact/#/?v=1-2&smp=smp%3A%2F%2Fu2dS9sG8nMNURyZwqASV4yROM28Er0luVTx5X1CsMrU%3D%40smp4.simplex.im%2FShQuD-rPokbDvkyotKx5NwM8P3oUXHxA%23%2F%3Fv%3D1-2%26dh%3DMCowBQYDK2VuAyEA6fSx1k9zrOmF0BJpCaTarZvnZpMTAVQhd3RkDQ35KT0%253D%26srv%3Do5vmywmrnaxalvz6wi3zicyftgio6psuvyniis6gco6bp6ekl4cqj4id.onion"),
      peerType = Just CPTBot,
      preferences = Nothing
    }

timeItToView :: String -> CM' a -> CM' a
timeItToView s action = do
  t1 <- liftIO getCurrentTime
  a <- action
  t2 <- liftIO getCurrentTime
  let diff = diffToMilliseconds $ diffUTCTime t2 t1
  toView' $ CEvtTimedAction s diff
  pure a

epochStart :: UTCTime
epochStart = UTCTime (fromGregorian 1970 1 1) (secondsToDiffTime 0)
